home *** CD-ROM | disk | FTP | other *** search
/ Your Choice 1 / your choice.zip / your choice / PRGMMING / VISIONIX / VDATESU.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-30  |  67KB  |  3,353 lines
  1. {
  2.  ════════════════════════════════════════════════════════════════════════════
  3.  
  4.  Visionix Date Functions Unit (VDATES)
  5.    Version 0.12
  6.  Copyright 1991,92,93 Visionix
  7.  ALL RIGHTS RESERVED
  8.  
  9.  ────────────────────────────────────────────────────────────────────────────
  10.  
  11.  Revision history in reverse chronological order:
  12.  
  13.  Initials  Date      Comment
  14.  ────────  ────────  ────────────────────────────────────────────────────────
  15.  
  16.  jrt       12/06/93  Added SwatchExpired
  17.  
  18.  mep       11/25/93  Added Unix date functions.
  19.  
  20.  mep       11/19/93  Total rewriting of unit.  Much easier to use now.
  21.  
  22.  lpg       03/21/93  Changed: TDateTime -> TDTime, DateTime -> TDateTime.
  23.  
  24.  lpg       03/13/93  Added Source Documentation
  25.  
  26.  mep       02/11/93  Cleaned up code for beta release
  27.  
  28.  jrt       02/08/93  Sync with beta 0.12 release
  29.  
  30.  lpg       01/13/93  Added: ValidDateTime
  31.  
  32.  mep       12/18/92  Added: TimeToStrHM and DateToStrDay for VCopy use.
  33.  
  34.  jrt       12/07/92  Sync with beta 0.11 release
  35.  
  36.  lpg       11/24/92  Modified & corrected DT functions,
  37.  
  38.  jrt       11/21/92  Sync with beta 0.08
  39.  
  40.  lpg       10/23/92  Made more Functions & Tested
  41.  
  42.  lpg       10/19/92  Created
  43.  
  44.  ════════════════════════════════════════════════════════════════════════════
  45. }
  46.  
  47. (*-
  48.  
  49. [TEXT]
  50.  
  51. <Overview>
  52.  
  53. VDATES is the collection of various date and time functions.  Some features
  54. include:
  55.  
  56.   ■ Day of week, Leap Year, Days in month, and Daylight Savings.
  57.  
  58.   ■ Type validations.
  59.  
  60.   ■ DateTime (from DOS unit) is now called TDateTime (for Windows compat.).
  61.  
  62.   ■ TDateTime inc, dec, add, sub, and absolution difference.
  63.  
  64.   ■ Julian date <--> DateTime conversions (for your Date-math functions).
  65.  
  66.   ■ Packed DateTime extractions and conversions.
  67.  
  68.   ■ Stop Watch (TSwatch) for the time-of-day in seconds (with 100th second
  69.     accuracy).  TSwatch also has inc, dec, add, sub, and distance functions.
  70.  
  71.   ■ System Clock functions: clock ticks since midnight, setting system
  72.     date and time, setting system alarm (these work with BCD parameters).
  73.  
  74.   ■ and much more...
  75.  
  76. <Interface>
  77.  
  78. -*)
  79.  
  80. Unit VDatesu;
  81.  
  82. Interface
  83.  
  84. {──────────────────────────────────────────────────────────────────────────}
  85.  
  86. Uses
  87.  
  88.   VTypesu,
  89.   VGenu,
  90.   VStringu,
  91.   DOS;
  92.  
  93. {──────────────────────────────────────────────────────────────────────────}
  94.  
  95. Const
  96.  
  97.   {-----------------------------------}
  98.   { Constants for Date/Time functions }
  99.   {-----------------------------------}
  100.  
  101.   cdt100sInDay = 8640000;
  102.  
  103.   cdtSecsInDay = 86400;          { Number of seconds per day }
  104.  
  105.   cdtSecsInHour = 3600;
  106.  
  107.   cdtDaysInMonth : Array[1..12] of BYTE =
  108.     (31,28,31,30,31,30,31,31,30,31,30,31);
  109.  
  110.   cdtYearBase  : WORD = 1980;    { The assumed beginning year for functions }
  111.  
  112.   cdtDayStr    : Array[0..6] of String[15] =
  113.                  ( 'Sunday',   'Monday', 'Tuesday', 'Wednesday',
  114.                    'Thursday', 'Friday', 'Saturday' );
  115.  
  116.   cdtMonthStr  : Array[1..12] of String[12] =
  117.                  ( 'January',   'February', 'March',    'April',
  118.                    'May',       'June',     'July',     'August',
  119.                    'September', 'October',  'November', 'December' );
  120.  
  121.   cdtDateTimeMask : STRING = 'WWW  $MMM D+, $Y+  HH:II:SS';
  122.  
  123.   cdtSwatchMask   : STRING = 'HH:II:SS.1+';
  124.  
  125.   cdtUnixBase     = 2440588; { Julian days for 1/1/1970 }
  126.  
  127.  
  128.  
  129.  
  130. Type
  131.  
  132.   {---------------------------------------------------------------}
  133.   { Since TPW redefines DateTime (DOS.TPU) to TDateTime, use this }
  134.   { instead of DateTime (for compatibility).                      }
  135.   {---------------------------------------------------------------}
  136.  
  137. {$IFNDEF TDateTime}
  138.  
  139.   TDateTime    = DateTime;
  140.  
  141. {$ENDIF}
  142.  
  143.   TDateTimeEx  = RECORD    { DateTime type with extensions }
  144.  
  145.     Year       : WORD;
  146.     Month      : WORD;
  147.     Day        : WORD;
  148.     DOW        : WORD;
  149.     Hour       : WORD;
  150.     Min        : WORD;
  151.     Sec        : WORD;
  152.     Sec100     : WORD;
  153.  
  154.   END;
  155.  
  156.   TPackedDT    = LONGINT; { Packed TDateTime (4-bytes as used in DOS) }
  157.  
  158.   TSwatch      = REAL;  { StopWatch in seconds (decimal is 100th seconds) }
  159.  
  160.   TJulian      = LONGINT; { Linear date system (for calendar math) }
  161.  
  162.   TUnixDT      = LONGINT; { Seconds since Jan 1, 1970  12:00:00 AM }
  163.  
  164. {════════════════════════════════════════════════════════════════════════════}
  165.  
  166.  
  167. {-----------------}
  168. { Basic Functions }
  169. {-----------------}
  170.  
  171. Function  DayOfWeek(              DT             : TDateTime ) : WORD;
  172.  
  173. Function  IsLeapYear(             Year           : WORD      ) : BOOLEAN;
  174.  
  175. Function  LeapYearDays(           Year           : WORD      ) : INTEGER;
  176.  
  177. Function  DaysInMonth(            Month          : WORD;
  178.                                   Year           : WORD      ) : INTEGER;
  179.  
  180. Function  IsDayLightSavings(      DT             : TDateTime ) : BOOLEAN;
  181.  
  182. Function  IsTimePM(               Swatch         : TSwatch   ) : BOOLEAN;
  183.  
  184. Function  CompleteYear(           Year           : WORD      ) : WORD;
  185.  
  186. Function  VDatesMaskStr(          DTEx           : TDateTimeEx;
  187.                                   MaskStr        : STRING    ) : STRING;
  188.  
  189. {---------------------}
  190. { Validation of Types }
  191. {---------------------}
  192.  
  193. Function  ValidDate(              Year           : WORD;
  194.                                   Month          : WORD;
  195.                                   Day            : WORD      ) : BOOLEAN;
  196.  
  197. Function  ValidTime(              Hour           : WORD;
  198.                                   Min            : WORD;
  199.                                   Sec            : WORD      ) : BOOLEAN;
  200.  
  201. Function  ValidDateTime(          DT             : TDateTime ) : BOOLEAN;
  202.  
  203. Function  ValidPacked(            PackedDT       : TPackedDT ) : BOOLEAN;
  204.  
  205. Function  ValidSwatch(            Swatch         : TSwatch   ) : BOOLEAN;
  206.  
  207.  
  208. {---------------------}
  209. { TDateTime Functions }
  210. {---------------------}
  211.  
  212. Procedure CurrDateTime(       Var DT             : TDateTime );
  213.  
  214. Function  DateTimeStr(            DT             : TDateTime ) : STRING;
  215.  
  216. Function  DateTimeMaskStr(        DT             : TDateTime;
  217.                                   Mask           : STRING    ) : STRING;
  218.  
  219. Procedure IncDateTime(        Var DT             : TDateTime );
  220.  
  221. Procedure DecDateTime(        Var DT             : TDateTime );
  222.  
  223. Procedure AddDateTime(            DTAdd          : TDateTime;
  224.                               Var DT             : TDateTime );
  225.  
  226. Procedure SubDateTime(            DTSub          : TDateTime;
  227.                               Var DT             : TDateTime );
  228.  
  229. Procedure DateTimeDiff(           DT1            : TDateTime;
  230.                                   DT2            : TDateTime;
  231.                               Var DTDiff         : TDateTime );
  232.  
  233. Procedure ExToDateTime(           DTEx           : TDateTimeEx;
  234.                               Var DT             : TDateTime   );
  235.  
  236. Procedure DateTimeToEx(           DT             : TDateTime;
  237.                               Var DTEx           : TDateTimeEx );
  238.  
  239. Function  DTtoJulian(             DT             : TDateTime ) : TJulian;
  240.  
  241. Procedure JulianToDT(             J              : TJulian;
  242.                               Var DT             : TDateTime );
  243.  
  244.  
  245. Function  DTtoSwatch(             DT             : TDateTime ) : TSwatch;
  246.  
  247. Procedure SwatchToDT(             Swatch         : TSwatch;
  248.                               Var DT             : TDateTime );
  249.  
  250. Function  DTtoUnix(               DT             : TDateTime ) : TUnixDT;
  251.  
  252. Procedure UnixToDT(               UnixDT         : TUnixDT;
  253.                               Var DT             : TDateTime );
  254.  
  255. {---------------------------}
  256. { Packed DateTime Functions }
  257. {---------------------------}
  258.  
  259. Function  CurrPackedDT                                         : TPackedDT;
  260.  
  261. Function  GetPackedDate(          PackedDT       : TPackedDT ) : WORD;
  262.  
  263. Function  GetPackedTime(          PackedDT       : TPackedDT ) : WORD;
  264.  
  265.  
  266. {------------------}
  267. { Swatch Functions }
  268. {------------------}
  269.  
  270. Function  CurrSwatch                                           : TSwatch;
  271.  
  272. Function  HMS1ToSwatch(           Hour           : WORD;
  273.                                   Min            : WORD;
  274.                                   Sec            : WORD;
  275.                                   Sec100         : WORD      ) : TSwatch;
  276.  
  277. Procedure SwatchToHMS1(           Swatch         : TSwatch;
  278.                               Var Hour           : WORD;
  279.                               Var Min            : WORD;
  280.                               Var Sec            : WORD;
  281.                               Var Sec100         : WORD      );
  282.  
  283. Function  SwatchStr(              Swatch         : TSwatch   ) : STRING;
  284.  
  285. Function  SwatchMaskStr(          Swatch         : TSwatch;
  286.                                   Mask           : STRING    ) : STRING;
  287.  
  288. Function  AddSwatch(              Swatch         : TSwatch;
  289.                                   Hours          : WORD;
  290.                                   Mins           : WORD;
  291.                                   Secs           : WORD;
  292.                                   Sec100s        : WORD      ) : TSwatch;
  293.  
  294. Function  SubSwatch(              Swatch         : TSwatch;
  295.                                   Hours          : WORD;
  296.                                   Mins           : WORD;
  297.                                   Secs           : WORD;
  298.                                   Sec100s        : WORD      ) : TSwatch;
  299.  
  300. Procedure SwatchDiff(             Swatch1        : TSwatch;
  301.                                   Swatch2        : TSwatch;
  302.                               Var Hours          : WORD;
  303.                               Var Mins           : WORD;
  304.                               Var Secs           : WORD;
  305.                               Var Sec100s        : WORD      );
  306.  
  307. Function  SwatchExpired(          Swatch1        : TSwatch;
  308.                                   Expire100s     : LONGINT   ) : BOOLEAN;
  309.  
  310. {------------------------}
  311. { System Clock Functions }
  312. {------------------------}
  313.  
  314. Function SetTicksSinceMidnt(      Ticks          : LONGINT   ) : BOOLEAN;
  315.  
  316. Function GetTicksSinceMidnt(  Var Days           : BYTE      ) : LONGINT;
  317.  
  318.  
  319. Function SetSysTime(              BCDHours       : BYTE;
  320.                                   BCDMins        : BYTE;
  321.                                   BCDSecs        : BYTE;
  322.                                   DSTActive      : BOOLEAN   ) : BOOLEAN;
  323.  
  324. Function GetSysTime(          Var BCDHours       : BYTE;
  325.                               Var BCDmins        : BYTE;
  326.                               Var BCDSecs        : BYTE;
  327.                               Var DSTActive      : BOOLEAN   ) : BOOLEAN;
  328.  
  329. Function SetSysDate(              BCDDay         : BYTE;
  330.                                   BCDMon         : BYTE;
  331.                                   BCDYear        : BYTE;
  332.                                   BCDCent        : BYTE      ) : BOOLEAN;
  333.  
  334. Function GetSysDate(          Var BCDDay         : BYTE;
  335.                               Var BCDMon         : BYTE;
  336.                               Var BCDYear        : BYTE;
  337.                               Var BCDCent        : BYTE      ) : BOOLEAN;
  338.  
  339. Function SetSysAlarmOn(           BCDHours       : BYTE;
  340.                                   BCDMins        : BYTE;
  341.                                   BCDSecs        : BYTE      ) : BOOLEAN;
  342.  
  343. Function SetSysAlarmOff                                        : BOOLEAN;
  344.  
  345.  
  346. Procedure Sleep(                  Sleep100s      : LONGINT   );
  347.  
  348. {════════════════════════════════════════════════════════════════════════════}
  349.  
  350. Implementation
  351.  
  352. {────────────────────────────────────────────────────────────────────────────}
  353.  
  354. (*-
  355.  
  356. [FUNCTION]
  357.  
  358. Function  DayOfWeek(              DT             : TDateTime ) : WORD;
  359.  
  360. [PARAMETERS]
  361.  
  362. DT          TDateTime (only Date part is important)
  363.  
  364. [RETURNS]
  365.  
  366. Day of week (0 = Sunday to 6 = Saturday)
  367.  
  368. [DESCRIPTION]
  369.  
  370. Finds out the day of the week from the given date.
  371.  
  372. [SEE-ALSO]
  373.  
  374. [EXAMPLE]
  375.  
  376. -*)
  377.  
  378. Function  DayOfWeek(              DT             : TDateTime ) : WORD;
  379.  
  380. Var
  381.  
  382.   Julian : TJulian;
  383.  
  384. BEGIN
  385.  
  386.   DayOfWeek := Succ(DTtoJulian(DT)) MOD 7;
  387.  
  388. END;
  389.  
  390. {────────────────────────────────────────────────────────────────────────────}
  391.  
  392. (*-
  393.  
  394. [FUNCTION]
  395.  
  396. Function  IsLeapYear(             Year           : WORD      ) : BOOLEAN;
  397.  
  398. [PARAMETERS]
  399.  
  400. Year        Source Year
  401.  
  402. [RETURNS]
  403.  
  404. Whether the source year is a leap year.
  405.  
  406. [DESCRIPTION]
  407.  
  408. Will return true if given year is a "leap year".
  409.  
  410. [SEE-ALSO]
  411.  
  412. [EXAMPLE]
  413.  
  414. -*)
  415.  
  416. Function  IsLeapYear(             Year           : WORD      ) : BOOLEAN;
  417.  
  418. BEGIN
  419.  
  420.   IsLeapYear := ( ( ( Year MOD 4 = 0 ) AND
  421.                     ( Year MOD 100 <> 0 ) ) OR
  422.                   ( Year MOD 400 = 0 ) );
  423.  
  424. END;
  425.  
  426. {────────────────────────────────────────────────────────────────────────────}
  427.  
  428. (*-
  429.  
  430. [FUNCTION]
  431.  
  432. Function  LeapYearDays(           Year           : WORD      ) : INTEGER;
  433.  
  434. [PARAMETERS]
  435.  
  436. Year        Source Year
  437.  
  438. [RETURNS]
  439.  
  440. Number of days in leap year.
  441.  
  442. [DESCRIPTION]
  443.  
  444. Calculates the extra number of days in a given year (by figuring leap
  445. year and century).  A no-leap year will be 0, a leap year will be 1, and
  446. a leap century will be 2.
  447.  
  448. [SEE-ALSO]
  449.  
  450. [EXAMPLE]
  451.  
  452. -*)
  453.  
  454. Function  LeapYearDays(           Year           : WORD      ) : INTEGER;
  455.  
  456. Var
  457.  
  458.   Days : INTEGER;
  459.  
  460. BEGIN
  461.  
  462.   Days := 0;
  463.  
  464.   If (Year MOD 4 = 0) AND (Year MOD 100 <> 0) Then
  465.     Inc(Days);
  466.  
  467.   LeapYearDays := Days;
  468.  
  469. END;
  470.  
  471. {────────────────────────────────────────────────────────────────────────────}
  472.  
  473. (*-
  474.  
  475. [FUNCTION]
  476.  
  477. Function  DaysInMonth(            Month          : WORD;
  478.                                   Year           : WORD      ) : INTEGER;
  479.  
  480. [PARAMETERS]
  481.  
  482. Month       Source Month
  483. Year        Source Year
  484.  
  485. [RETURNS]
  486.  
  487. Number of Days in the Source Month.
  488.  
  489. [DESCRIPTION]
  490.  
  491. Based upon the provided Month and Year, returns the number of days that
  492. are in that month.  This takes into account Leap Year Days for Feberuary.
  493.  
  494. [SEE-ALSO]
  495.  
  496. [EXAMPLE]
  497.  
  498. -*)
  499.  
  500. Function  DaysInMonth(            Month          : WORD;
  501.                                   Year           : WORD      ) : INTEGER;
  502.  
  503. BEGIN
  504.  
  505.   If (Month = 2) Then
  506.     DaysInMonth := cdtDaysInMonth[2] + Byte(LeapYearDays(Year))
  507.   Else
  508.     DaysInMonth := cdtDaysInMonth[Month];
  509.  
  510. END;
  511.  
  512. {────────────────────────────────────────────────────────────────────────────}
  513.  
  514. (*-
  515.  
  516. [FUNCTION]
  517.  
  518. Function  IsDayLightSavings(      DT             : TDateTime ) : BOOLEAN;
  519.  
  520. [PARAMETERS]
  521.  
  522. DT          Source Date and Hour
  523.  
  524. [RETURNS]
  525.  
  526. Returns whether DayLight Savings is in effect.
  527.  
  528. [DESCRIPTION]
  529.  
  530. Per an Act of Congress of 1986, the Spring Change Day was set to be
  531. the 1st Sunday in April with the Fall Change Day being the the last
  532. Sunday in October.  Prior to this the Spring Change Day was the last
  533. Sunday in April.
  534.  
  535. Per this Act, individual states and areas were free to elect to use
  536. DayLight Savings or not.  Some of the areas which have Elected not to
  537. are Arizona, Hawaii, Peurto Rico, the Virgin Islands, the American
  538. Samoas, and part of the following States: Indiana, Kansas, Texas,
  539. Florida, Michigan, and Alaska.
  540.  
  541. [SEE-ALSO]
  542.  
  543. [EXAMPLE]
  544.  
  545. -*)
  546.  
  547. Function  IsDayLightSavings(      DT             : TDateTime ) : BOOLEAN;
  548.  
  549. Const
  550.  
  551.   SpringMonth = 4;
  552.   FallMonth   = 10;
  553.   ChangeHour  = 2;  { 2 AM }
  554.  
  555. Var
  556.  
  557.   DLS     : BOOLEAN;
  558.   DT2     : TDateTime;
  559.   ThisDay : INTEGER;
  560.  
  561. BEGIN
  562.  
  563.   If ( (DT.Month < SpringMonth) or (DT.Month > FallMonth) ) Then
  564.     DLS := FALSE
  565.   Else
  566.  
  567.   If ( (DT.Month > SpringMonth) And (DT.Month < FallMonth) ) Then
  568.     DLS := TRUE
  569.   Else
  570.  
  571.   If (DT.Month = SpringMonth) Then
  572.   BEGIN
  573.  
  574.     {-------------------}
  575.     { Find first Sunday }
  576.     {-------------------}
  577.  
  578.     DT2     := DT;
  579.     DT2.Day := 1;
  580.  
  581.     While DayOfWeek( DT2 ) <> 0 Do
  582.       Inc(DT2.Day);
  583.  
  584.     If DT.Day < DT2.Day Then
  585.       DLS := FALSE
  586.     Else
  587.  
  588.     If DT.Day > DT2.Day Then
  589.       DLS := TRUE
  590.  
  591.     Else
  592.     BEGIN
  593.  
  594.       {------------------}
  595.       { Compare 2am time }
  596.       {------------------}
  597.  
  598.       If DT.Hour < ChangeHour Then
  599.         DLS := FALSE
  600.       Else
  601.         DLS := TRUE;
  602.  
  603.     END;
  604.  
  605.   END
  606.   Else
  607.  
  608.   If (DT.Month = FallMonth) Then
  609.   BEGIN
  610.  
  611.     {------------------}
  612.     { Find last Sunday }
  613.     {------------------}
  614.  
  615.     DT2     := DT;
  616.     DT2.Day := DaysInMonth(FallMonth, DT.Year);
  617.  
  618.     While DayOfWeek( DT2 ) <> 0 Do
  619.       Dec(DT2.Day);
  620.  
  621.     If DT.Day < DT2.Day Then
  622.       DLS := FALSE
  623.     Else
  624.  
  625.     If DT.Day > DT2.Day Then
  626.       DLS := TRUE
  627.     Else
  628.     BEGIN
  629.  
  630.       {------------------}
  631.       { Compare 2am time }
  632.       {------------------}
  633.  
  634.       If DT.Hour < ChangeHour Then
  635.         DLS := FALSE
  636.       Else
  637.         DLS := TRUE;
  638.  
  639.     END;
  640.  
  641.   END;
  642.  
  643. END;
  644.  
  645. {────────────────────────────────────────────────────────────────────────────}
  646.  
  647. (*-
  648.  
  649. [FUNCTION]
  650.  
  651. Function  IsTimePM(               Swatch         : TSwatch   ) : BOOLEAN;
  652.  
  653. [PARAMETERS]
  654.  
  655. Swatch      Source Time
  656.  
  657. [RETURNS]
  658.  
  659. Whether the source time is Post Meridian [PM]
  660.  
  661. [DESCRIPTION]
  662.  
  663. Returns whether the source time is AM or PM.  If it is PM the function
  664. reports TRUE, else AM=FALSE.
  665.  
  666. [SEE-ALSO]
  667.  
  668. [EXAMPLE]
  669.  
  670. -*)
  671.  
  672. Function  IsTimePM(               Swatch         : TSwatch   ) : BOOLEAN;
  673.  
  674. BEGIN
  675.  
  676.   IsTimePM := ( Swatch >= ( cdtSecsInDay DIV 2) );
  677.  
  678. END;
  679.  
  680. {────────────────────────────────────────────────────────────────────────────}
  681.  
  682. (*-
  683.  
  684. [FUNCTION]
  685.  
  686. Function  CompleteYear(           Year           : WORD      ) : WORD;
  687.  
  688. [PARAMETERS]
  689.  
  690. Year        The partial year (ie. 93, but can be 1993 for completeness)
  691.  
  692. [RETURNS]
  693.  
  694. The completed year (ie. 1993)
  695.  
  696. [DESCRIPTION]
  697.  
  698. This figures out an incomplete given year.  This uses cdtYearBase as the
  699. demarker between centuries.
  700.  
  701. [SEE-ALSO]
  702.  
  703. [EXAMPLE]
  704.  
  705.   W := CompleteYear( 93 );
  706.  
  707.   { W = 1993 }
  708.  
  709.   W := CompleteYear( 3 );
  710.  
  711.   { W = 2003 }
  712.  
  713. -*)
  714.  
  715. Function  CompleteYear(           Year           : WORD      ) : WORD;
  716.  
  717. BEGIN
  718.  
  719.   If (Year < 1900) Then
  720.     Year := Year + 1900;
  721.  
  722.   If (Year < cdtYearBase) Then
  723.     Year := Year + 100;
  724.  
  725.   CompleteYear := Year;
  726.  
  727. END;
  728.  
  729. {────────────────────────────────────────────────────────────────────────────}
  730.  
  731. (*-
  732.  
  733. [FUNCTION]
  734.  
  735. Function  VDatesMaskStr(          DTEx           : TDateTimeEx;
  736.                                   MaskStr        : STRING    ) : STRING;
  737.  
  738. [PARAMETERS]
  739.  
  740. DTEx        Date and time set with extensions.
  741. MaskStr     String to put date and time set "over".
  742.  
  743. [RETURNS]
  744.  
  745. Formatted string.
  746.  
  747. [DESCRIPTION]
  748.  
  749. Converts a date and time set into a string using a specified template.
  750.  
  751. Some of the command entries are:
  752.  
  753.   'Y' = Year.
  754.   'M' = Month.
  755.   'D' = Day.
  756.   'H' = Hour.
  757.   'I' = Minute.
  758.   'S' = Second.
  759.   'W' = Day of Week.
  760.   '1' = 100th Second.
  761.   '#' = Use a value formatting of next entry.
  762.   '$' = Use a string formatting of next entry.
  763.   '+' = Complete the previous entry.
  764.  
  765. NOTES:
  766.  
  767.   ■ Years default to the 2-character representation of that year.  For
  768.     example, '93' for the year 1993.  If the whole '1993' needs to be
  769.     shown, use string formatting as '$YYYY' or '$Y+'.
  770.  
  771.   ■ Days, if toggled with string formatting, will add an ordinal suffix
  772.     to the output.  For example: on day 12, '$D+' would return '12th'.
  773.  
  774. [SEE-ALSO]
  775.  
  776. [EXAMPLE]
  777.  
  778. Var
  779.  
  780.   DTEx : TDateTimeEx;
  781.   S    : STRING;
  782.  
  783. BEGIN
  784.  
  785.   DTEx.Year   := 1993;
  786.   DTEx.Month  := 11;
  787.   DTEx.Day    := 1;
  788.   DTEx.Hour   := 12;
  789.   DTEx.Min    := 34;
  790.   DTEx.Sec    := 56;
  791.   DTEx.Sec100 := 561;
  792.  
  793.   S := VDatesMaskStr( DTEx, '$M+' );
  794.  
  795.   { S = 'November' }
  796.  
  797.   S := VDatesMaskStr( DTEx, 'W+ M+/D+/Y+ H+:I+:S+.1+' );
  798.  
  799.   { S = 'Monday 11/1/1993 12:34:56.0' }
  800.  
  801.   S := VDatesMaskStr( DTEx, 'WW DD/MM/YY' );
  802.  
  803.   { S = 'Mo 1/11/93' }
  804.  
  805. -*)
  806.  
  807. Function  VDatesMaskStr(          DTEx           : TDateTimeEx;
  808.                                   MaskStr        : STRING    ) : STRING;
  809.  
  810. Const
  811.  
  812.   MaxMode = 11;
  813.  
  814. Type
  815.  
  816.   TModeRec = RECORD
  817.  
  818.     Mask     : CHAR;
  819.     Index    : BYTE;
  820.     S        : STRING[20];    { MaxCount = Length(S) }
  821.  
  822.   END;
  823.  
  824.   TModes = Array[1..MaxMode] of TModeRec;
  825.  
  826. Var
  827.  
  828.   DT   : TDateTime;
  829.   Mode : TModes;
  830.   Last : BYTE;
  831.   Times: INTEGER;
  832.   S    : STRING;
  833.  
  834.   L1   : BYTE;
  835.   L2   : BYTE;
  836.   L3   : BYTE;
  837.  
  838. BEGIN
  839.  
  840.   {-------------------------}
  841.   { Initialize lookup table }
  842.   {-------------------------}
  843.  
  844.   For L1 := 1 to MaxMode Do
  845.     Mode[L1].Index := 1;
  846.  
  847.   Mode[1].Mask  := 'Y'; { Year                 }
  848.   Mode[2].Mask  := 'M'; { Month                }
  849.   Mode[3].Mask  := 'D'; { Day                  }
  850.   Mode[4].Mask  := 'H'; { Hours                }
  851.   Mode[5].Mask  := 'I'; { Minutes              }
  852.   Mode[6].Mask  := 'S'; { Seconds              }
  853.   Mode[7].Mask  := 'W'; { DayOfWeek            }
  854.   Mode[8].Mask  := '1'; { Seconds (100th)      }
  855.   Mode[9].Mask  := '#'; { Value of next entry  }
  856.   Mode[10].Mask := '$'; { String of next entry }
  857.   Mode[11].Mask := '+'; { Complete last entry  }
  858.  
  859.   {---------------------------}
  860.   { Default entry definations }
  861.   {---------------------------}
  862.  
  863.   Mode[1].S := IntToStr(DTEx.Year);
  864.   Mode[1].S := CopyStr( Mode[1].S,
  865.                         LesserInt( Byte(Mode[1].S[0]), 3 ),
  866.                         LesserInt( Byte(Mode[1].S[0]), 2 ) );
  867.   Mode[2].S := IntToStr(DTEx.Month);
  868.   Mode[3].S := IntToStr(DTEx.Day);
  869.   Mode[4].S := Pad( IntToStr(DTEx.Hour), 2, OnLeft, '0' );
  870.   Mode[5].S := Pad( IntToStr(DTEx.Min),  2, OnLeft, '0' );
  871.   Mode[6].S := Pad( IntToStr(DTEx.Sec),  2, OnLeft, '0' );
  872.  
  873.   ExToDateTime( DTEx, DT );
  874.   Mode[7].S := cdtDayStr[DayOfWeek(DT)]; { !! Assumes to calc DOW; not given }
  875.  
  876.   Mode[8].S := IntToStr(DTEx.Sec100);
  877.   Mode[9].S  := ' ';
  878.   Mode[10].S := ' ';
  879.   Mode[11].S := ' ';
  880.  
  881.   S    := '';
  882.   Last := 0;
  883.  
  884.   {---------------------------}
  885.   { Now scan through mask and }
  886.   { create output string from }
  887.   {---------------------------}
  888.  
  889.   For L1 := 1 to Byte(MaskStr[0]) Do
  890.   BEGIN
  891.  
  892.     {-----------------------------------}
  893.     { Look for mask character in lookup }
  894.     {-----------------------------------}
  895.  
  896.     L2 := 1;
  897.  
  898.     While (L2 <= MaxMode) AND
  899.           (MaskStr[L1] <> Mode[L2].Mask) Do
  900.       Inc(L2);
  901.  
  902.     If L2 > MaxMode Then
  903.       S := S + MaskStr[L1]
  904.     Else
  905.  
  906.     If Mode[L2].Index <= Byte(Mode[L2].S[0]) Then
  907.     BEGIN
  908.  
  909.       Times := 1;
  910.  
  911.       Case L2 of
  912.  
  913.          9 :
  914.  
  915.           BEGIN
  916.  
  917.             If Succ(L1) <= Byte(MaskStr[0]) Then
  918.             BEGIN
  919.  
  920.               Inc(L1);
  921.  
  922.               L2 := 1;
  923.  
  924.               While (L2 <= MaxMode) AND
  925.                     (MaskStr[L1] <> Mode[L2].Mask) Do
  926.                 Inc(L2);
  927.  
  928.               If L2 <= MaxMode Then
  929.               BEGIN
  930.  
  931.                 If NOT ValidLong( Mode[L2].S ) Then
  932.                 BEGIN
  933.  
  934.                   Case L2 Of
  935.  
  936.                     1 : Mode[1].S := CopyStr(IntToStr(DTEx.Year), 3, 2);
  937.                     2 : Mode[2].S := IntToStr(DTEx.Month);
  938.                     3 : Mode[3].S := IntToStr(DTEx.Day);
  939.                     4 : Mode[4].S := Pad(IntToStr(DTEx.Hour),2,OnLeft,'0');
  940.                     5 : Mode[5].S := Pad(IntToStr(DTEx.Min),2,OnLeft,'0');
  941.                     6 : Mode[6].S := Pad(IntToStr(DTEx.Sec),2,OnLeft,'0');
  942.                     7 :
  943.                       BEGIN
  944.                         ExToDateTime(DTEx, DT);
  945.                         Mode[7].S := IntToStr(DayOfWeek(DT)); { !! }
  946.                       END;
  947.  
  948.                     8 : Mode[8].S := IntToStr(DTEx.Sec100);
  949.  
  950.                   End;
  951.  
  952.                 END;
  953.  
  954.               END;
  955.  
  956.             END;
  957.  
  958.           END;
  959.  
  960.         10 :
  961.  
  962.           BEGIN
  963.  
  964.             If Succ(L1) <= Byte(MaskStr[0]) Then
  965.             BEGIN
  966.  
  967.               Inc(L1);
  968.  
  969.               L2 := 1;
  970.  
  971.               While (L2 <= MaxMode) AND
  972.                     (MaskStr[L1] <> Mode[L2].Mask) Do
  973.                 Inc(L2);
  974.  
  975.               If L2 <= MaxMode Then
  976.               BEGIN
  977.  
  978.                 If ValidLong( Mode[L2].S ) Then
  979.                 BEGIN
  980.  
  981.                   Case L2 Of
  982.  
  983.                     1 : Mode[1].S := IntToStr(DTEx.Year);
  984.                     2 : Mode[2].S := cdtMonthStr[DTEx.Month];
  985. { !^!                   3 : Mode[3].S := IntToStr(DTEx.Day) + OrdSuffix(DTEx.Day);}
  986.                     4 : Mode[4].S := IntToText(DTEx.Hour);
  987.                     5 : Mode[5].S := IntToText(DTEx.Min);
  988.                     6 : Mode[6].S := IntToText(DTEx.Sec);
  989.                     7 :
  990.                       BEGIN
  991.                         ExToDateTime(DTEx, DT);
  992.                         Mode[7].S := cdtDayStr[DayOfWeek(DT)]; { !! }
  993.                       END;
  994.  
  995.                     8 : Mode[8].S := IntToText(DTEx.Sec100);
  996.  
  997.                   End;
  998.  
  999.                 END;
  1000.  
  1001.               END;
  1002.  
  1003.             END;
  1004.  
  1005.           END;
  1006.  
  1007.         11 :
  1008.  
  1009.           BEGIN
  1010.  
  1011.             L2    := Last;
  1012.             Times := Byte(Mode[L2].S[0]) - Mode[L2].Index + 1;
  1013.  
  1014.           END;
  1015.  
  1016.       End;
  1017.  
  1018.       For L3 := 1 to Times Do
  1019.       BEGIN
  1020.  
  1021.         S := S + Mode[L2].S[ Mode[L2].Index ];
  1022.         Inc(Mode[L2].Index);
  1023.  
  1024.       END;
  1025.  
  1026.       Last := L2;
  1027.  
  1028.     END;
  1029.  
  1030.   END;
  1031.  
  1032.   VDatesMaskStr := S;
  1033.  
  1034. END;
  1035.  
  1036. {────────────────────────────────────────────────────────────────────────────}
  1037.  
  1038. (*-
  1039.  
  1040. [FUNCTION]
  1041.  
  1042. Function  ValidDate(              Year           : WORD;
  1043.                                   Month          : WORD;
  1044.                                   Day            : WORD      ) : BOOLEAN;
  1045.  
  1046. [PARAMETERS]
  1047.  
  1048. Day         Source Day
  1049. Mon         Source Month
  1050. Year        Source Year
  1051.  
  1052. [RETURNS]
  1053.  
  1054. Condition of values.
  1055.  
  1056. [DESCRIPTION]
  1057.  
  1058. Checks if all values are within their proper range.
  1059.  
  1060. [SEE-ALSO]
  1061.  
  1062. [EXAMPLE]
  1063.  
  1064. -*)
  1065.  
  1066. Function  ValidDate(              Year           : WORD;
  1067.                                   Month          : WORD;
  1068.                                   Day            : WORD      ) : BOOLEAN;
  1069.  
  1070. BEGIN
  1071.  
  1072.   ValidDate := (Day >= 1) AND
  1073.                (Day <= DaysInMonth(Month, Year)) AND
  1074.                (Month >= 1) AND
  1075.                (Month <= 12) AND
  1076.                (Year >= cdtYearBase);
  1077.  
  1078. END;
  1079.  
  1080. {────────────────────────────────────────────────────────────────────────────}
  1081.  
  1082. (*-
  1083.  
  1084. [FUNCTION]
  1085.  
  1086. Function  ValidTime(              Hour           : WORD;
  1087.                                   Min            : WORD;
  1088.                                   Sec            : WORD      ) : BOOLEAN;
  1089.  
  1090. [PARAMETERS]
  1091.  
  1092. Hour        Source Hours
  1093. Min         Source Minutes
  1094. Sec         Source Seconds
  1095.  
  1096. [RETURNS]
  1097.  
  1098. Condition of values.
  1099.  
  1100. [DESCRIPTION]
  1101.  
  1102. Checks if all values are within their proper range.
  1103.  
  1104. [SEE-ALSO]
  1105.  
  1106. [EXAMPLE]
  1107.  
  1108. -*)
  1109.  
  1110. Function  ValidTime(              Hour           : WORD;
  1111.                                   Min            : WORD;
  1112.                                   Sec            : WORD      ) : BOOLEAN;
  1113.  
  1114. BEGIN
  1115.  
  1116.   ValidTime := (Hour < 24) AND
  1117.                (Min  < 60) AND
  1118.                (Sec  < 60);
  1119.  
  1120. END;
  1121.  
  1122. {────────────────────────────────────────────────────────────────────────────}
  1123.  
  1124. (*-
  1125.  
  1126. [FUNCTION]
  1127.  
  1128. Function  ValidDateTime(          DT             : TDateTime ) : BOOLEAN;
  1129.  
  1130. [PARAMETERS]
  1131.  
  1132. DT          Source DateTime
  1133.  
  1134. [RETURNS]
  1135.  
  1136. Condition of values.
  1137.  
  1138. [DESCRIPTION]
  1139.  
  1140. Checks if all values are within their proper range.
  1141.  
  1142. [SEE-ALSO]
  1143.  
  1144. [EXAMPLE]
  1145.  
  1146. -*)
  1147.  
  1148. Function  ValidDateTime(          DT             : TDateTime ) : BOOLEAN;
  1149.  
  1150. BEGIN
  1151.  
  1152.   ValidDateTime := ValidTime( DT.Hour, DT.Min, DT.Sec ) AND
  1153.                    ValidDate( DT.Day, DT.Month, DT.Year );
  1154.  
  1155. END;
  1156.  
  1157. {────────────────────────────────────────────────────────────────────────────}
  1158.  
  1159. (*-
  1160.  
  1161. [FUNCTION]
  1162.  
  1163. Function  ValidPacked(            PackedDT       : TPackedDT ) : BOOLEAN;
  1164.  
  1165. [PARAMETERS]
  1166.  
  1167. PackedDT    Source Packed DateTime
  1168.  
  1169. [RETURNS]
  1170.  
  1171. Condition of values.
  1172.  
  1173. [DESCRIPTION]
  1174.  
  1175. Checks if all values are within their proper range.
  1176.  
  1177. [SEE-ALSO]
  1178.  
  1179. [EXAMPLE]
  1180.  
  1181. -*)
  1182.  
  1183. Function  ValidPacked(            PackedDT       : TPackedDT ) : BOOLEAN;
  1184.  
  1185. Var
  1186.  
  1187.   DT : TDateTime;
  1188.  
  1189. BEGIN
  1190.  
  1191.   UnpackTime(PackedDT, DT);
  1192.   ValidPacked := ValidDateTime(DT);
  1193.  
  1194. END;
  1195.  
  1196. {────────────────────────────────────────────────────────────────────────────}
  1197.  
  1198. (*-
  1199.  
  1200. [FUNCTION]
  1201.  
  1202. Function  ValidSwatch(            Swatch         : TSwatch   ) : BOOLEAN;
  1203.  
  1204. [PARAMETERS]
  1205.  
  1206. Swatch      Source StopWatch
  1207.  
  1208. [RETURNS]
  1209.  
  1210. Condition of values.
  1211.  
  1212. [DESCRIPTION]
  1213.  
  1214. Checks if all values are within their proper range.
  1215.  
  1216. [SEE-ALSO]
  1217.  
  1218. [EXAMPLE]
  1219.  
  1220. -*)
  1221.  
  1222. Function  ValidSwatch(            Swatch         : TSwatch   ) : BOOLEAN;
  1223.  
  1224. BEGIN
  1225.  
  1226.   ValidSwatch := ( Swatch >= 0 ) AND
  1227.                  ( Round(Swatch) < cdtSecsInDay );
  1228.  
  1229. END;
  1230.  
  1231. {────────────────────────────────────────────────────────────────────────────}
  1232.  
  1233. (*-
  1234.  
  1235. [FUNCTION]
  1236.  
  1237. Procedure CurrDateTime(       Var DT             : TDateTime );
  1238.  
  1239. [PARAMETERS]
  1240.  
  1241. DT          Variable to put clock date/time into
  1242.  
  1243. [RETURNS]
  1244.  
  1245. (VAR     : DOS date/time )
  1246.  
  1247. [DESCRIPTION]
  1248.  
  1249. Returns the current date and time set in the operating system
  1250.  
  1251. [SEE-ALSO]
  1252.  
  1253. [EXAMPLE]
  1254.  
  1255. -*)
  1256.  
  1257. Procedure CurrDateTime(       Var DT             : TDateTime );
  1258.  
  1259. Var
  1260.  
  1261.   Temp : WORD;
  1262.  
  1263. BEGIN
  1264.  
  1265.   GetDate( DT.Year, DT.Month, DT.Day, Temp );
  1266.   GetTime( DT.Hour, DT.Min,   DT.Sec, Temp );
  1267.  
  1268. END;
  1269.  
  1270. {────────────────────────────────────────────────────────────────────────────}
  1271.  
  1272. (*-
  1273.  
  1274. [FUNCTION]
  1275.  
  1276. Function  DateTimeStr(            DT             : TDateTime ) : STRING;
  1277.  
  1278. [PARAMETERS]
  1279.  
  1280. DT          Date/Time to convert
  1281.  
  1282. [RETURNS]
  1283.  
  1284. Converted string
  1285.  
  1286. [DESCRIPTION]
  1287.  
  1288. Converts Date/Time into string following the template as defined in
  1289. the variable constant cdpDateTimeMask.
  1290.  
  1291. [SEE-ALSO]
  1292.  
  1293. [EXAMPLE]
  1294.  
  1295. -*)
  1296.  
  1297. Function  DateTimeStr(            DT             : TDateTime ) : STRING;
  1298.  
  1299. Var
  1300.  
  1301.   DTEx : TDateTimeEx;
  1302.  
  1303. BEGIN
  1304.  
  1305.   DateTimeToEx( DT, DTEx );
  1306.   DateTimeStr := VDatesMaskStr( DTEx, cdtDateTimeMask );
  1307.  
  1308. END;
  1309.  
  1310. {────────────────────────────────────────────────────────────────────────────}
  1311.  
  1312. (*-
  1313.  
  1314. [FUNCTION]
  1315.  
  1316. Function  DateTimeMaskStr(        DT             : TDateTime;
  1317.                                   Mask           : STRING    ) : STRING;
  1318.  
  1319. [PARAMETERS]
  1320.  
  1321. DT          Date/Time to convert
  1322.  
  1323. [RETURNS]
  1324.  
  1325. Converted string
  1326.  
  1327. [DESCRIPTION]
  1328.  
  1329. Converts Date/Time into string following the template of Mask.
  1330.  
  1331. [SEE-ALSO]
  1332.  
  1333. [EXAMPLE]
  1334.  
  1335. -*)
  1336.  
  1337. Function  DateTimeMaskStr(        DT             : TDateTime;
  1338.                                   Mask           : STRING    ) : STRING;
  1339. Var
  1340.  
  1341.   DTEx : TDateTimeEx;
  1342.  
  1343. BEGIN
  1344.  
  1345.   DateTimeToEx( DT, DTEx );
  1346.   DateTimeMaskStr := VDatesMaskStr( DTEx, Mask );
  1347.  
  1348. END;
  1349.  
  1350. {────────────────────────────────────────────────────────────────────────────}
  1351.  
  1352. (*-
  1353.  
  1354. [FUNCTION]
  1355.  
  1356. Procedure IncDateTime(        Var DT             : TDateTime );
  1357.  
  1358. [PARAMETERS]
  1359.  
  1360. DT          Date/Time to increment
  1361.  
  1362. [RETURNS]
  1363.  
  1364. DT          Incremented Date/Time
  1365.  
  1366. [DESCRIPTION]
  1367.  
  1368. Increments a Date/Time record by one second.  Adjusts components accordingly.
  1369.  
  1370. [SEE-ALSO]
  1371.  
  1372. [EXAMPLE]
  1373.  
  1374. -*)
  1375.  
  1376. Procedure IncDateTime(        Var DT             : TDateTime );
  1377.  
  1378. Var
  1379.   DTemp : TDateTime;
  1380.  
  1381. BEGIN
  1382.  
  1383.   DTemp := DT;
  1384.  
  1385.   Inc( DT.Sec );
  1386.  
  1387.   While (DT.Sec > 59) Do
  1388.   BEGIN
  1389.  
  1390.     Dec( DT.Sec, 60 );
  1391.     Inc( DT.Min );
  1392.  
  1393.   END;  { While DT.Sec }
  1394.  
  1395.   While (DT.Min > 59) Do
  1396.   BEGIN
  1397.  
  1398.     Dec( DT.Min, 60 );
  1399.     Inc( DT.Hour );
  1400.  
  1401.   END;  { While DT.Min }
  1402.  
  1403.   While (DT.Hour > 23) Do
  1404.   BEGIN
  1405.  
  1406.     Dec( DT.Hour, 24 );
  1407.     Inc( DT.Day );
  1408.  
  1409.   END;  { While DT.Hour }
  1410.  
  1411.   While (DT.Day > DaysInMonth( DT.Month MOD 12+1, DT.Year ) ) Do
  1412.   BEGIN
  1413.  
  1414.     Dec( DT.Day, DaysInMonth( DT.Month MOD 12+1, DT.Year ) );
  1415.     Inc( DT.Month );
  1416.  
  1417.   END;  { While DT.Day }
  1418.  
  1419.   While (DT.Month > 12) Do
  1420.   BEGIN
  1421.  
  1422.     Dec( DT.Month, 12 );
  1423.     Inc( DT.Year );
  1424.  
  1425.   END;  { While DT.Month }
  1426.  
  1427.   If NOT ValidDateTime( DT ) Then
  1428.     DT := DTemp;
  1429.  
  1430. END;
  1431.  
  1432. {────────────────────────────────────────────────────────────────────────────}
  1433.  
  1434. (*-
  1435.  
  1436. [FUNCTION]
  1437.  
  1438. Procedure DecDateTime(        Var DT             : TDateTime );
  1439.  
  1440. [PARAMETERS]
  1441.  
  1442. DT          Date/Time to decrement
  1443.  
  1444. [RETURNS]
  1445.  
  1446. DT          Decremented Date/Time
  1447.  
  1448. [DESCRIPTION]
  1449.  
  1450. Decrements a Date/Time record by one second.  Adjusts components accordingly.
  1451.  
  1452. [SEE-ALSO]
  1453.  
  1454. [EXAMPLE]
  1455.  
  1456. -*)
  1457.  
  1458. Procedure DecDateTime(        Var DT             : TDateTime );
  1459.  
  1460. Var
  1461.  
  1462.   DTemp : TDateTime;
  1463.  
  1464. BEGIN
  1465.  
  1466.   DTemp := DT;
  1467.  
  1468.   Dec( DT.Sec, 1 );
  1469.  
  1470.   While (DT.Sec < 0) Do
  1471.   BEGIN
  1472.  
  1473.     Inc( DT.Sec, 60 );
  1474.     Dec( DT.Min );
  1475.  
  1476.   END;
  1477.  
  1478.   While (DT.Min < 0) Do
  1479.   BEGIN
  1480.  
  1481.     Inc( DT.Min, 60 );
  1482.     Dec( DT.Hour );
  1483.  
  1484.   END;
  1485.  
  1486.   While (DT.Hour < 0) Do
  1487.   BEGIN
  1488.  
  1489.     Inc( DT.Hour, 24 );
  1490.     Dec( DT.Day );
  1491.  
  1492.   END;
  1493.  
  1494.   While (DT.Day < 1) Do
  1495.   BEGIN
  1496.  
  1497.     Inc( DT.Day, DaysInMonth( (DT.Month-1) MOD 12 + 1, DT.Year ) );
  1498.     Dec( DT.Month );
  1499.  
  1500.   END;
  1501.  
  1502.   While (DT.Month < 1) Do
  1503.   BEGIN
  1504.  
  1505.     Inc( DT.Month, 12 );
  1506.     Dec( DT.Year );
  1507.  
  1508.   END;
  1509.  
  1510.   If NOT ValidDateTime( DT ) Then
  1511.     DT := DTemp;
  1512.  
  1513. END;
  1514.  
  1515. {────────────────────────────────────────────────────────────────────────────}
  1516.  
  1517. (*-
  1518.  
  1519. [FUNCTION]
  1520.  
  1521. Procedure AddDateTime(            DTAdd          : TDateTime;
  1522.                               Var DT             : TDateTime );
  1523.  
  1524. [PARAMETERS]
  1525.  
  1526. DTAdd       Date/Time to add
  1527.  
  1528. [RETURNS]
  1529.  
  1530. DT          Base TDateTime with additions
  1531.  
  1532. [DESCRIPTION]
  1533.  
  1534. Adds specified DateTime components to a given TDateTime.
  1535.  
  1536. [SEE-ALSO]
  1537.  
  1538. [EXAMPLE]
  1539.  
  1540. -*)
  1541.  
  1542. Procedure AddDateTime(            DTAdd          : TDateTime;
  1543.                               Var DT             : TDateTime );
  1544.  
  1545. VAR
  1546.  
  1547.   DTemp      : TDateTime;
  1548.   Hr,Min,Sec : INTEGER;
  1549.   Day,Mon,Yr : INTEGER;
  1550.  
  1551. BEGIN
  1552.  
  1553.   DTemp := DT;
  1554.  
  1555.   Hr  := DT.Hour;
  1556.   Min := DT.Min;
  1557.   Sec := DT.Sec;
  1558.   Day := DT.Day;
  1559.   Mon := DT.Month;
  1560.   Yr  := DT.Year;
  1561.  
  1562.   Inc( Hr,  DTAdd.Hour );
  1563.   Inc( Min, DTAdd.Min );
  1564.   Inc( Sec, DTAdd.Sec );
  1565.   Inc( Day, DTAdd.Day );
  1566.   Inc( Mon, DTAdd.Month );
  1567.   Inc( Yr,  DTAdd.Year );
  1568.  
  1569.   While (Sec > 59) Do
  1570.   BEGIN
  1571.  
  1572.     Dec( Sec, 60 );
  1573.     Inc( Min );
  1574.  
  1575.   END;  { If Sec }
  1576.  
  1577.   While (Min > 59) Do
  1578.   BEGIN
  1579.  
  1580.     Dec( Min, 60 );
  1581.     Inc( Hr );
  1582.  
  1583.   END;  { If Min }
  1584.  
  1585.   While (Hr > 23) Do
  1586.   BEGIN
  1587.  
  1588.     Dec( Hr, 24 );
  1589.     Inc( Day );
  1590.  
  1591.   END;  { If Hr }
  1592.  
  1593.   While (Mon > 12) Do
  1594.   BEGIN
  1595.  
  1596.     Dec( Mon, 12 );
  1597.     Inc( Yr );
  1598.  
  1599.   END;  { If Mon }
  1600.  
  1601.   While (Day > DaysInMonth( Mon, Yr ) ) Do
  1602.   BEGIN
  1603.  
  1604.     Dec( Day, DaysInMonth( Mon, Yr ) );
  1605.     Inc( Mon );
  1606.  
  1607.     If (Mon > 12) Then
  1608.     BEGIN
  1609.  
  1610.       Dec( Mon, 12 );
  1611.       Inc( Yr );
  1612.  
  1613.     END;  { If Mon }
  1614.  
  1615.   END;  { If Day }
  1616.  
  1617.   DT.Hour  := Hr;
  1618.   DT.Min   := Min;
  1619.   DT.Sec   := Sec;
  1620.   DT.Day   := Day;
  1621.   DT.Month := Mon;
  1622.   DT.Year  := Yr;
  1623.  
  1624.   If NOT ValidDateTime( DT ) Then
  1625.     DT := DTemp;
  1626.  
  1627. END;
  1628.  
  1629. {────────────────────────────────────────────────────────────────────────────}
  1630.  
  1631. (*-
  1632.  
  1633. [FUNCTION]
  1634.  
  1635. Procedure SubDateTime(            DTSub          : TDateTime;
  1636.                               Var DT             : TDateTime );
  1637.  
  1638. [PARAMETERS]
  1639.  
  1640. DTSub       Date/Time to subtract
  1641.  
  1642. [RETURNS]
  1643.  
  1644. DT          Base TDateTime with subtractions.
  1645.  
  1646. [DESCRIPTION]
  1647.  
  1648. Subtracts specified DateTime components to a given TDateTime.
  1649.  
  1650. [SEE-ALSO]
  1651.  
  1652. [EXAMPLE]
  1653.  
  1654. -*)
  1655.  
  1656. Procedure SubDateTime(            DTSub          : TDateTime;
  1657.                               Var DT             : TDateTime );
  1658.  
  1659. Var
  1660.  
  1661.   Hr,Min,Sec : INTEGER;
  1662.   Day,Mon,Yr : INTEGER;
  1663.  
  1664. BEGIN
  1665.  
  1666.   Hr  := DT.Hour;
  1667.   Min := DT.Min;
  1668.   Sec := DT.Sec;
  1669.   Day := DT.Day;
  1670.   Mon := DT.Month;
  1671.   Yr  := DT.Year;
  1672.  
  1673.   Dec( Hr,  DTSub.Hour );
  1674.   Dec( Min, DTSub.Min );
  1675.   Dec( Sec, DTSub.Sec );
  1676.   Dec( Day, DTSub.Day );
  1677.   Dec( Mon, DTSub.Month );
  1678.   Dec( Yr,  DTSub.Year );
  1679.  
  1680.   While (Sec < 0) Do
  1681.   BEGIN
  1682.  
  1683.     Inc( Sec, 60 );
  1684.     Dec( Min );
  1685.  
  1686.   END;  { While Sec }
  1687.  
  1688.   While (Min < 0) Do
  1689.   BEGIN
  1690.  
  1691.     Inc( Min, 60 );
  1692.     Dec( Hr );
  1693.  
  1694.   END;  { While Min }
  1695.  
  1696.   While (Hr < 0) Do
  1697.   BEGIN
  1698.  
  1699.     Inc( Hr, 24 );
  1700.     Dec( Day );
  1701.  
  1702.   END;  { While Hr }
  1703.  
  1704.   While (Mon < 1) Do
  1705.   BEGIN
  1706.  
  1707.     Inc( Mon, 12 );
  1708.     Dec( Yr );
  1709.  
  1710.   END;  { While Mon }
  1711.  
  1712.   While (Day < 1) Do
  1713.   BEGIN
  1714.  
  1715.     If Mon = 1 Then
  1716.       Inc( Day, DaysInMonth( (Mon-2) MOD 12 + 13, Yr-1 ) )
  1717.  
  1718.     Else
  1719.       Inc( Day, DaysInMonth( (Mon-2) MOD 12 + 1, Yr ) );
  1720.  
  1721.     Dec( Mon );
  1722.  
  1723.     If (Mon < 1) Then
  1724.     BEGIN
  1725.  
  1726.       Inc( Mon, 12 );
  1727.       Dec( Yr );
  1728.  
  1729.     END;  { If Mon }
  1730.  
  1731.   END;  { While Day }
  1732.  
  1733.   DT.Hour  := Hr;
  1734.   DT.Min   := Min;
  1735.   DT.Sec   := Sec;
  1736.   DT.Day   := Day;
  1737.   DT.Month := Mon;
  1738.   DT.Year  := Yr;
  1739.  
  1740. END;
  1741.  
  1742. {────────────────────────────────────────────────────────────────────────────}
  1743.  
  1744. (*-
  1745.  
  1746. [FUNCTION]
  1747.  
  1748. Procedure DateTimeDiff(           DT1            : TDateTime;
  1749.                                   DT2            : TDateTime;
  1750.                               Var DTDiff         : TDateTime );
  1751.  
  1752. [PARAMETERS]
  1753.  
  1754. DT1         Date/Time #1
  1755. DT2         Date/Time #2
  1756.  
  1757. [RETURNS]
  1758.  
  1759. DTDiff      Date/Time differences
  1760.  
  1761. [DESCRIPTION]
  1762.  
  1763. Calculates the absolute difference (distance between) the two given
  1764. TDateTime types.
  1765.  
  1766. [SEE-ALSO]
  1767.  
  1768. [EXAMPLE]
  1769.  
  1770. -*)
  1771.  
  1772. Procedure DateTimeDiff(           DT1            : TDateTime;
  1773.                                   DT2            : TDateTime;
  1774.                               Var DTDiff         : TDateTime );
  1775.  
  1776. Var
  1777.  
  1778.   P1  : TPackedDT;
  1779.   P2  : TPackedDT;
  1780.  
  1781. BEGIN
  1782.  
  1783.   PackTime( DT1, P1 );
  1784.   PackTime( DT2, P2 );
  1785.  
  1786.   If P1 > P2 Then
  1787.   BEGIN
  1788.  
  1789.     DTDiff := DT1;
  1790.     SubDateTime( DT2, DTDiff );
  1791.  
  1792.   END
  1793.   Else
  1794.   BEGIN
  1795.  
  1796.     DTDiff := DT2;
  1797.     SubDateTime( DT1, DTDiff );
  1798.  
  1799.   END;
  1800.  
  1801. END;
  1802.  
  1803. {────────────────────────────────────────────────────────────────────────────}
  1804.  
  1805. (*-
  1806.  
  1807. [FUNCTION]
  1808.  
  1809. Procedure ExToDateTime(           DTEx           : TDateTimeEx;
  1810.                               Var DT             : TDateTime   );
  1811.  
  1812. [PARAMETERS]
  1813.  
  1814. DTEx        DateTime with extensions
  1815.  
  1816. [RETURNS]
  1817.  
  1818. DT          DateTime without extensions
  1819.  
  1820. [DESCRIPTION]
  1821.  
  1822. Removes the DOW and Sec100 from a TDateTimeEx type and puts the
  1823. rest into a TDateTime type.
  1824.  
  1825. [SEE-ALSO]
  1826.  
  1827. [EXAMPLE]
  1828.  
  1829. -*)
  1830.  
  1831. Procedure ExToDateTime(           DTEx           : TDateTimeEx;
  1832.                               Var DT             : TDateTime   );
  1833.  
  1834. BEGIN
  1835.  
  1836.   DT.Year  := DTEx.Year;
  1837.   DT.Month := DTEx.Month;
  1838.   DT.Day   := DTEx.Day;
  1839.   DT.Hour  := DTEx.Hour;
  1840.   DT.Min   := DTEx.Min;
  1841.   DT.Sec   := DTEx.Sec;
  1842.  
  1843. END;
  1844.  
  1845. {────────────────────────────────────────────────────────────────────────────}
  1846.  
  1847. (*-
  1848.  
  1849. [FUNCTION]
  1850.  
  1851. Procedure DateTimeToEx(           DT             : TDateTime;
  1852.                               Var DTEx           : TDateTimeEx );
  1853.  
  1854. [PARAMETERS]
  1855.  
  1856. DT          DateTime without Extensions
  1857.  
  1858. [RETURNS]
  1859.  
  1860. DTEx        DateTime with Extensions (initialized)
  1861.  
  1862. [DESCRIPTION]
  1863.  
  1864. Creates a TDateTimeEx type from a given TDateTime type.  This only
  1865. initializes the extensions.
  1866.  
  1867. [SEE-ALSO]
  1868.  
  1869. [EXAMPLE]
  1870.  
  1871. -*)
  1872.  
  1873. Procedure DateTimeToEx(           DT             : TDateTime;
  1874.                               Var DTEx           : TDateTimeEx );
  1875.  
  1876. BEGIN
  1877.  
  1878.   DTEx.Year  := DT.Year;
  1879.   DTEx.Month := DT.Month;
  1880.   DTEx.Day   := DT.Day;
  1881.   DTEx.Hour  := DT.Hour;
  1882.   DTEx.Min   := DT.Min;
  1883.   DTEx.Sec   := DT.Sec;
  1884.   DTEx.DOW   := 0;
  1885.   DTEx.Sec100:= 0;
  1886.  
  1887. END;
  1888.  
  1889. {────────────────────────────────────────────────────────────────────────────}
  1890.  
  1891. (*-
  1892.  
  1893. [FUNCTION]
  1894.  
  1895. Function  DTtoJulian(             DT             : TDateTime ) : TJulian;
  1896.  
  1897. [PARAMETERS]
  1898.  
  1899. DT          Day/Month/Year to convert
  1900.  
  1901. [RETURNS]
  1902.  
  1903. Julian date
  1904.  
  1905. [DESCRIPTION]
  1906.  
  1907. Converts a Gregorian calendar Day, Month, and Year into a Julian calendar
  1908. date (linear date system).
  1909.  
  1910. [SEE-ALSO]
  1911.  
  1912. [EXAMPLE]
  1913.  
  1914. -*)
  1915.  
  1916. Function  DTtoJulian(             DT             : TDateTime ) : TJulian;
  1917.  
  1918. Var
  1919.  
  1920.   AY : INTEGER;
  1921.   Y  : WORD;
  1922.   M  : BYTE;
  1923.   D  : TJulian;
  1924.   G  : TJulian;
  1925.  
  1926. BEGIN
  1927.  
  1928.   AY := DT.Year;
  1929.  
  1930.   If AY < 0 Then
  1931.     Y := AY + 4717
  1932.   Else
  1933.     Y := AY + 4716;
  1934.  
  1935.   If DT.Month < 3 Then
  1936.   BEGIN
  1937.  
  1938.     M  := LongInt(DT.Month) + 12;
  1939.     Dec(Y);
  1940.     Dec(AY);
  1941.  
  1942.   END
  1943.   Else
  1944.     M := LongInt(DT.Month);
  1945.  
  1946.   D := ( 1461 * LongInt(Y)) SHR 2 + (153 * (Succ(M)) DIV 5) +
  1947.          LongInt(DT.Day) - 1524;
  1948.  
  1949.   G := D + 2 - AY DIV 100 + AY DIV 400 - AY DIV 4000;
  1950.  
  1951.   If G >= 2299161 Then
  1952.     DTtoJulian := G
  1953.   Else
  1954.     DTtoJulian := D;
  1955.  
  1956. END;
  1957.  
  1958. {────────────────────────────────────────────────────────────────────────────}
  1959.  
  1960. (*-
  1961.  
  1962. [FUNCTION]
  1963.  
  1964. Procedure JulianToDT(             J              : TJulian;
  1965.                               Var DT             : TDateTime );
  1966.  
  1967. [PARAMETERS]
  1968.  
  1969. J           Julian date
  1970.  
  1971. [RETURNS]
  1972.  
  1973. DT          TDateTime with Day/Month/Year filled
  1974.  
  1975. [DESCRIPTION]
  1976.  
  1977. Converts a Julian calendar date (linear date system) into its Gregorian
  1978. Day, Month, and Year equivalent.
  1979.  
  1980. [SEE-ALSO]
  1981.  
  1982. [EXAMPLE]
  1983.  
  1984. -*)
  1985.  
  1986. Procedure JulianToDT(             J              : TJulian;
  1987.                               Var DT             : TDateTime );
  1988.  
  1989.  
  1990. Var
  1991.  
  1992.   AA,
  1993.   AB,
  1994.   A   : TJulian;
  1995.   B,
  1996.   D,
  1997.   EE  : LONGINT;
  1998.   C   : WORD;
  1999.   E   : BYTE;
  2000.   Y   : INTEGER;
  2001.  
  2002. BEGIN
  2003.  
  2004.   If J < 2299161 Then
  2005.     A := LongInt(J)
  2006.   Else
  2007.   BEGIN
  2008.  
  2009.     AA := J - 1721120;
  2010.     AB := 31 * (AA DIV 1460969);
  2011.     AA := AA MOD 1460969;
  2012.     AB := AB + 3 * (AA DIV 146097);
  2013.     AA := AA MOD 146097;
  2014.  
  2015.     If AA = 146096 Then
  2016.       AB := AB + 3
  2017.     Else
  2018.       AB := AB + AA DIV 36524;
  2019.  
  2020.     A := J + (AB - 2)
  2021.  
  2022.   END;
  2023.  
  2024.   B  := A + 1524;
  2025.   C  := (20 * B - 2442) DIV 7305;
  2026.   D  := 1461 * LongInt(C) SHR 2;
  2027.   EE := B - D;
  2028.   E  := 10000 * EE DIV 306001;
  2029.   DT.Day := Word(EE - 306001 * E DIV 10000);
  2030.  
  2031.   If E >= 14 Then
  2032.     DT.Month := Word(E - 13)
  2033.   Else
  2034.     DT.Month := Word(Pred(E));
  2035.  
  2036.   If DT.Month > 2 Then
  2037.     Y := C - 4716
  2038.   Else
  2039.     Y := C - 4715;
  2040.  
  2041.   If Y < 1 Then
  2042.     DT.Year := Word(Pred(Y))
  2043.   Else
  2044.     DT.Year := Word(Y);
  2045.  
  2046. END;
  2047.  
  2048. {────────────────────────────────────────────────────────────────────────────}
  2049.  
  2050. (*-
  2051.  
  2052. [FUNCTION]
  2053.  
  2054. Function  DTtoSwatch(             DT             : TDateTime ) : TSwatch;
  2055.  
  2056. [PARAMETERS]
  2057.  
  2058. DT          Date/Time (date part is ignored)
  2059.  
  2060. [RETURNS]
  2061.  
  2062. Swatch with hours, minutes, and seconds.
  2063.  
  2064. [DESCRIPTION]
  2065.  
  2066. Converts a TDateTime type into a swatch.  Note that the date portion is
  2067. ignored.
  2068.  
  2069. [SEE-ALSO]
  2070.  
  2071. [EXAMPLE]
  2072.  
  2073. -*)
  2074.  
  2075. Function  DTtoSwatch(             DT             : TDateTime ) : TSwatch;
  2076.  
  2077. BEGIN
  2078.  
  2079.   DTtoSwatch := HMS1toSwatch( DT.Hour, DT.Min, DT.Sec, 0 );
  2080.  
  2081. END;
  2082.  
  2083. {────────────────────────────────────────────────────────────────────────────}
  2084.  
  2085. (*-
  2086.  
  2087. [FUNCTION]
  2088.  
  2089. Procedure SwatchToDT(             Swatch         : TSwatch;
  2090.                               Var DT             : TDateTime );
  2091.  
  2092. [PARAMETERS]
  2093.  
  2094. Swatch      TSwatch source
  2095.  
  2096. [RETURNS]
  2097.  
  2098. TDateTime type with hour, min, and sec filled.
  2099.  
  2100. [DESCRIPTION]
  2101.  
  2102. Converts a TSwatch type into a TDateTime with hour, min, and sec filled.
  2103. Note that the date portion of the TDateTime is ignored.
  2104.  
  2105. [SEE-ALSO]
  2106.  
  2107. [EXAMPLE]
  2108.  
  2109. -*)
  2110.  
  2111. Procedure SwatchToDT(             Swatch         : TSwatch;
  2112.                               Var DT             : TDateTime );
  2113.  
  2114. Var
  2115.  
  2116.   Sec100 : WORD;
  2117.  
  2118. BEGIN
  2119.  
  2120.   SwatchToHMS1( Swatch, DT.Hour, DT.Min, DT.Sec, Sec100 );
  2121.  
  2122. END;
  2123.  
  2124. {────────────────────────────────────────────────────────────────────────────}
  2125.  
  2126. (*-
  2127.  
  2128. [FUNCTION]
  2129.  
  2130. Function  DTtoUnix(               DT             : TDateTime ) : TUnixDT;
  2131.  
  2132. [PARAMETERS]
  2133.  
  2134. DT          TDateTime source
  2135.  
  2136. [RETURNS]
  2137.  
  2138. Unix time code (base 1970)
  2139.  
  2140. [DESCRIPTION]
  2141.  
  2142. This converts a TDateTime into seconds from January 1st, 1970 (12:00 AM
  2143. Greenwich time).
  2144.  
  2145. [SEE-ALSO]
  2146.  
  2147. [EXAMPLE]
  2148.  
  2149. -*)
  2150.  
  2151. Function  DTtoUnix(               DT             : TDateTime ) : TUnixDT;
  2152.  
  2153. BEGIN
  2154.  
  2155.   { do time zone stuff later }
  2156.  
  2157.   DTToUnix := ( (DTtoJulian(DT) - cdtUnixBase) * cdtSecsInDay) +
  2158.                 Round(DTtoSwatch(DT) );
  2159.  
  2160. END;
  2161.  
  2162. {────────────────────────────────────────────────────────────────────────────}
  2163.  
  2164. (*-
  2165.  
  2166. [FUNCTION]
  2167.  
  2168. Procedure UnixToDT(               UnixDT         : TUnixDT;
  2169.                               Var DT             : TDateTime );
  2170.  
  2171. [PARAMETERS]
  2172.  
  2173. UnixDT      Unix time code (base 1970)
  2174.  
  2175. [RETURNS]
  2176.  
  2177. TDateTime destination
  2178.  
  2179. [DESCRIPTION]
  2180.  
  2181. Converts a Unix time code (seconds from base January 1st, 1970  12:00 AM
  2182. Greenwich time) into a DateTime type.
  2183.  
  2184. [SEE-ALSO]
  2185.  
  2186. [EXAMPLE]
  2187.  
  2188. -*)
  2189.  
  2190. Procedure UnixToDT(               UnixDT         : TUnixDT;
  2191.                               Var DT             : TDateTime );
  2192.  
  2193. BEGIN
  2194.  
  2195.   JulianToDT( (UnixDT DIV cdtSecsInDay) + cdtUnixBase, DT );
  2196.   SwatchToDT( (UnixDT MOD cdtSecsInDay), DT );
  2197.  
  2198. END;
  2199.  
  2200. {────────────────────────────────────────────────────────────────────────────}
  2201.  
  2202. (*-
  2203.  
  2204. [FUNCTION]
  2205.  
  2206. Function  CurrPackedDT                                         : TPackedDT;
  2207.  
  2208. [PARAMETERS]
  2209.  
  2210. [RETURNS]
  2211.  
  2212. Packed Date/Time
  2213.  
  2214. [DESCRIPTION]
  2215.  
  2216. Returns the current date and time set in a 4-byte bitfield record.
  2217.  
  2218. [SEE-ALSO]
  2219.  
  2220. [EXAMPLE]
  2221.  
  2222. -*)
  2223.  
  2224. Function  CurrPackedDT                                         : TPackedDT;
  2225.  
  2226. Var
  2227.  
  2228.   DT : TDateTime;
  2229.   PDT: TPackedDT;
  2230.  
  2231. BEGIN
  2232.  
  2233.   CurrDateTime( DT );
  2234.   PackTime( DT, PDT );
  2235.   CurrPackedDT := PDT;
  2236.  
  2237. END;
  2238.  
  2239. {────────────────────────────────────────────────────────────────────────────}
  2240.  
  2241. (*-
  2242.  
  2243. [FUNCTION]
  2244.  
  2245. Function  GetPackedDate(          PackedDT       : TPackedDT ) : WORD;
  2246.  
  2247. [PARAMETERS]
  2248.  
  2249. PackedDT    Packed TDateTime
  2250.  
  2251. [RETURNS]
  2252.  
  2253. Date as a WORD
  2254.  
  2255. [DESCRIPTION]
  2256.  
  2257. Returns date portion of a packed TDateTime.
  2258.  
  2259. [SEE-ALSO]
  2260.  
  2261. [EXAMPLE]
  2262.  
  2263. -*)
  2264.  
  2265. Function  GetPackedDate(          PackedDT       : TPackedDT ) : WORD;
  2266.  
  2267. BEGIN
  2268.  
  2269.   GetPackedDate := PackedDT SHR $10;
  2270.  
  2271. END;
  2272.  
  2273. {────────────────────────────────────────────────────────────────────────────}
  2274.  
  2275. (*-
  2276.  
  2277. [FUNCTION]
  2278.  
  2279. Function  GetPackedTime(          PackedDT       : TPackedDT ) : WORD;
  2280.  
  2281. [PARAMETERS]
  2282.  
  2283. PackedDT    Packed TDateTime
  2284.  
  2285. [RETURNS]
  2286.  
  2287. Time as a WORD
  2288.  
  2289. [DESCRIPTION]
  2290.  
  2291. Returns time portion of a packed TDateTime.
  2292.  
  2293. [SEE-ALSO]
  2294.  
  2295. [EXAMPLE]
  2296.  
  2297. -*)
  2298.  
  2299. Function  GetPackedTime(          PackedDT       : TPackedDT ) : WORD;
  2300.  
  2301. BEGIN
  2302.  
  2303.   GetPackedTime := PackedDT AND $FFFF;
  2304.  
  2305. END;
  2306.  
  2307. {────────────────────────────────────────────────────────────────────────────}
  2308.  
  2309. (*-
  2310.  
  2311. [FUNCTION]
  2312.  
  2313. Function  CurrSwatch                                           : TSwatch;
  2314.  
  2315. [PARAMETERS]
  2316.  
  2317. [RETURNS]
  2318.  
  2319. Swatch time.
  2320.  
  2321. [DESCRIPTION]
  2322.  
  2323. Returns the current time set of the operating system in seconds.
  2324.  
  2325. [SEE-ALSO]
  2326.  
  2327. [EXAMPLE]
  2328.  
  2329. -*)
  2330.  
  2331. Function  CurrSwatch                                           : TSwatch;
  2332.  
  2333. Var
  2334.  
  2335.   DTEx : TDateTimeEx;
  2336.  
  2337. BEGIN
  2338.  
  2339.   GetTime( DTEx.Hour, DTEx.Min, DTEx.Sec, DTEx.Sec100 );
  2340.   CurrSwatch := ( DTEx.Hour * 3600 ) +
  2341.                 ( DTEx.Min * 60 ) +
  2342.                 ( DTEx.Sec ) +
  2343.                 ( DTEx.Sec100 / 100 );
  2344.  
  2345. END;
  2346.  
  2347. {────────────────────────────────────────────────────────────────────────────}
  2348.  
  2349. (*-
  2350.  
  2351. [FUNCTION]
  2352.  
  2353. Function  HMS1ToSwatch(           Hour           : WORD;
  2354.                                   Min            : WORD;
  2355.                                   Sec            : WORD;
  2356.                                   Sec100         : WORD      ) : TSwatch;
  2357.  
  2358. [PARAMETERS]
  2359.  
  2360. Hour        Source hour
  2361. Min         Source minute
  2362. Sec         Source second
  2363.  
  2364. [RETURNS]
  2365.  
  2366. Swatch time.
  2367.  
  2368. [DESCRIPTION]
  2369.  
  2370. Converts the given Hour/Min/Sec into a TSwatch type.
  2371.  
  2372. [SEE-ALSO]
  2373.  
  2374. [EXAMPLE]
  2375.  
  2376. -*)
  2377.  
  2378. Function  HMS1ToSwatch(           Hour           : WORD;
  2379.                                   Min            : WORD;
  2380.                                   Sec            : WORD;
  2381.                                   Sec100         : WORD      ) : TSwatch;
  2382.  
  2383. BEGIN
  2384.  
  2385.   HMS1ToSwatch := ( Hour * 3600 ) +
  2386.                   ( Min  * 60 ) +
  2387.                   ( Sec ) +
  2388.                   ( Sec100 div 100 );
  2389.  
  2390. END;
  2391.  
  2392. {────────────────────────────────────────────────────────────────────────────}
  2393.  
  2394. (*-
  2395.  
  2396. [FUNCTION]
  2397.  
  2398. Procedure SwatchToHMS1(           Swatch         : TSwatch;
  2399.                               Var Hour           : WORD;
  2400.                               Var Min            : WORD;
  2401.                               Var Sec            : WORD;
  2402.                               Var Sec100         : WORD      );
  2403.  
  2404. [PARAMETERS]
  2405.  
  2406. Swatch      Given TSwatch type
  2407.  
  2408. [RETURNS]
  2409.  
  2410. Hour        Hour of Swatch
  2411. Min         Minute of Swatch
  2412. Sec         Second of Swatch
  2413. Sec100      100th second of Swatch
  2414.  
  2415. [DESCRIPTION]
  2416.  
  2417. Converts a TSwatch type into its Hour/Min/Sec/Sec100 components.
  2418.  
  2419.  
  2420. [SEE-ALSO]
  2421.  
  2422. [EXAMPLE]
  2423.  
  2424. -*)
  2425.  
  2426. Procedure SwatchToHMS1(           Swatch         : TSwatch;
  2427.                               Var Hour           : WORD;
  2428.                               Var Min            : WORD;
  2429.                               Var Sec            : WORD;
  2430.                               Var Sec100         : WORD      );
  2431.  
  2432. BEGIN
  2433.  
  2434.   Hour   := Round(Swatch) DIV 3600;
  2435.   Min    := (Round(Swatch) MOD 3600 ) DIV 60;
  2436.   Sec    := Round(Swatch) MOD 60;
  2437.   Sec100 := Round(Frac(Swatch) * 100);
  2438.  
  2439. END;
  2440.  
  2441. {────────────────────────────────────────────────────────────────────────────}
  2442.  
  2443. (*-
  2444.  
  2445. [FUNCTION]
  2446.  
  2447. Function  SwatchStr(              Swatch         : TSwatch   ) : STRING;
  2448.  
  2449. [PARAMETERS]
  2450.  
  2451. Swatch      Given TSwatch type
  2452.  
  2453. [RETURNS]
  2454.  
  2455. Swatch as a string.
  2456.  
  2457. [DESCRIPTION]
  2458.  
  2459. Converts a TSwatch type into a string using 'cdtSwatchMask' for string
  2460. formatting.
  2461.  
  2462. [SEE-ALSO]
  2463.  
  2464. [EXAMPLE]
  2465.  
  2466. -*)
  2467.  
  2468. Function  SwatchStr(              Swatch         : TSwatch   ) : STRING;
  2469.  
  2470. Var
  2471.  
  2472.   DTEx : TDateTimeEx;
  2473.  
  2474. BEGIN
  2475.  
  2476.   SwatchToHMS1( Swatch, DTEx.Hour, DTEx.Min, DTEx.Sec, DTEx.Sec100 );
  2477.   SwatchStr := VDatesMaskStr( DTEx, cdtSwatchMask );
  2478.  
  2479. END;
  2480.  
  2481. {────────────────────────────────────────────────────────────────────────────}
  2482.  
  2483. (*-
  2484.  
  2485. [FUNCTION]
  2486.  
  2487. Function  SwatchMaskStr(          Swatch         : TSwatch;
  2488.                                   Mask           : STRING    ) : STRING;
  2489.  
  2490. [PARAMETERS]
  2491.  
  2492. Swatch      Given TSwatch type
  2493.  
  2494. [RETURNS]
  2495.  
  2496. Swatch as a string.
  2497.  
  2498. [DESCRIPTION]
  2499.  
  2500. Converts a TSwatch type into a string using user-supplied mask for string
  2501. formatting.
  2502.  
  2503. [SEE-ALSO]
  2504.  
  2505. [EXAMPLE]
  2506.  
  2507. -*)
  2508.  
  2509. Function  SwatchMaskStr(          Swatch         : TSwatch;
  2510.                                   Mask           : STRING    ) : STRING;
  2511.  
  2512. Var
  2513.  
  2514.   DTEx : TDateTimeEx;
  2515.  
  2516. BEGIN
  2517.  
  2518.   SwatchToHMS1( Swatch, DTEx.Hour, DTEx.Min, DTEx.Sec, DTEx.Sec100 );
  2519.   SwatchMaskStr := VDatesMaskStr( DTEx, Mask );
  2520.  
  2521. END;
  2522.  
  2523. {────────────────────────────────────────────────────────────────────────────}
  2524.  
  2525. (*-
  2526.  
  2527. [FUNCTION]
  2528.  
  2529. Function  AddSwatch(              Swatch         : TSwatch;
  2530.                                   Hours          : WORD;
  2531.                                   Mins           : WORD;
  2532.                                   Secs           : WORD;
  2533.                                   Sec100s        : WORD      ) : TSwatch;
  2534.  
  2535. [PARAMETERS]
  2536.  
  2537. Swatch      TSwatch used as base time
  2538. Hours       Hours to add
  2539. Mins        Minutes to add
  2540. Secs        Seconds to add
  2541. Sec100s     100th seconds to add
  2542.  
  2543. [RETURNS]
  2544.  
  2545. TSwatch type
  2546.  
  2547. [DESCRIPTION]
  2548.  
  2549. Adds hours, minutes, seconds, and 100th seconds to a Swatch.  It will loop
  2550. around at every midnight;
  2551.  
  2552. [SEE-ALSO]
  2553.  
  2554. [EXAMPLE]
  2555.  
  2556. -*)
  2557.  
  2558. Function  AddSwatch(              Swatch         : TSwatch;
  2559.                                   Hours          : WORD;
  2560.                                   Mins           : WORD;
  2561.                                   Secs           : WORD;
  2562.                                   Sec100s        : WORD      ) : TSwatch;
  2563.  
  2564. Var
  2565.  
  2566.   Swatch2 : TSwatch;
  2567.  
  2568. BEGIN
  2569.  
  2570.   Swatch2 := Swatch + HMS1toSwatch( Hours, Mins, Secs, Sec100s );
  2571.  
  2572.   While (Swatch2 > cdtSecsInDay) Do
  2573.     Swatch2 := Swatch2 - cdtSecsInDay;
  2574.  
  2575.   AddSwatch := Swatch2;
  2576.  
  2577. END;
  2578.  
  2579. {────────────────────────────────────────────────────────────────────────────}
  2580.  
  2581. (*-
  2582.  
  2583. [FUNCTION]
  2584.  
  2585. Function  SubSwatch(              Swatch         : TSwatch;
  2586.                                   Hours          : WORD;
  2587.                                   Mins           : WORD;
  2588.                                   Secs           : WORD;
  2589.                                   Sec100s        : WORD      ) : TSwatch;
  2590.  
  2591. [PARAMETERS]
  2592.  
  2593. Swatch      TSwatch used as base time
  2594. Hours       Hours to subtract
  2595. Mins        Minutes to subtract
  2596. Secs        Seconds to subtract
  2597. Sec100s     100th seconds to subtract
  2598.  
  2599. [RETURNS]
  2600.  
  2601. TSwatch type
  2602.  
  2603. [DESCRIPTION]
  2604.  
  2605. Subtracts hours, minutes, seconds, and 100th seconds to a Swatch.  It
  2606. will loop around at every midnight.
  2607.  
  2608. [SEE-ALSO]
  2609.  
  2610. [EXAMPLE]
  2611.  
  2612. -*)
  2613.  
  2614. Function  SubSwatch(              Swatch         : TSwatch;
  2615.                                   Hours          : WORD;
  2616.                                   Mins           : WORD;
  2617.                                   Secs           : WORD;
  2618.                                   Sec100s        : WORD      ) : TSwatch;
  2619.  
  2620. Var
  2621.  
  2622.   Swatch2 : TSwatch;
  2623.  
  2624. BEGIN
  2625.  
  2626.   Swatch2 := HMS1toSwatch( Hours, Mins, Secs, Sec100s );
  2627.  
  2628.   While (Swatch2 > cdtSecsInDay) Do
  2629.     Swatch2 := Swatch2 - cdtSecsInDay;
  2630.  
  2631.   Swatch2 := Swatch - Swatch2;
  2632.  
  2633.   If Swatch2 < 0 Then
  2634.     SubSwatch := Swatch2 + cdtSecsInDay
  2635.   Else
  2636.     SubSwatch := Swatch2;
  2637.  
  2638. END;
  2639.  
  2640. {────────────────────────────────────────────────────────────────────────────}
  2641.  
  2642. (*-
  2643.  
  2644. [FUNCTION]
  2645.  
  2646. Procedure SwatchDiff(             Swatch1        : TSwatch;
  2647.                                   Swatch2        : TSwatch;
  2648.                               Var Hours          : WORD;
  2649.                               Var Mins           : WORD;
  2650.                               Var Secs           : WORD;
  2651.                               Var Sec100s        : WORD      );
  2652.  
  2653. [PARAMETERS]
  2654.  
  2655. Swatch1     TSwatch #1
  2656. Swatch2     TSwatch #2
  2657.  
  2658. [RETURNS]
  2659.  
  2660. Hours       Hour(s) difference
  2661. Mins        Min(s) difference
  2662. Secs        Second(s) difference
  2663. Sec100s     100th second(s) difference
  2664.  
  2665. [DESCRIPTION]
  2666.  
  2667. Returns the absolute difference (distance) between the two given Swatches.
  2668.  
  2669. [SEE-ALSO]
  2670.  
  2671. [EXAMPLE]
  2672.  
  2673. -*)
  2674.  
  2675. Procedure SwatchDiff(             Swatch1        : TSwatch;
  2676.                                   Swatch2        : TSwatch;
  2677.                               Var Hours          : WORD;
  2678.                               Var Mins           : WORD;
  2679.                               Var Secs           : WORD;
  2680.                               Var Sec100s        : WORD      );
  2681.  
  2682. Var
  2683.  
  2684.   Swatch3 : TSwatch;
  2685.  
  2686. BEGIN
  2687.  
  2688.   Swatch3 := Abs( Swatch1 - Swatch2 );
  2689.   SwatchToHMS1( Swatch3, Hours, Mins, Secs, Sec100s );
  2690.  
  2691. END;
  2692.  
  2693.  
  2694. {────────────────────────────────────────────────────────────────────────────}
  2695.  
  2696. (*-
  2697.  
  2698. [FUNCTION]
  2699.  
  2700. Function  SwatchExpired(          Swatch1        : TSwatch;
  2701.                                   Expire100s     : LONGINT   ) : BOOLEAN
  2702.  
  2703.  
  2704. [PARAMETERS]
  2705.  
  2706. Swatch1     TSwatch #1
  2707. Expire100s  Number of 100s after which the swatch will expire
  2708.  
  2709. [RETURNS]
  2710.  
  2711. TRUE        if "Expire100s" have passed since "Swatch1" or
  2712. FALSE       if "Expire100s" have NOT passed since "swatch1".
  2713.  
  2714.  
  2715. [DESCRIPTION]
  2716.  
  2717. Determines if a given "expire100s" count of 100/ths of a second have
  2718. passed since a given "swatch1" was "set".
  2719.  
  2720. [SEE-ALSO]
  2721.  
  2722. [EXAMPLE]
  2723.  
  2724.   SaveSwatch := CurrSwatch;
  2725.  
  2726.   If Not SwatchExpired( SaveSwatch, 200 ) Then
  2727.     Write( '.');
  2728.  
  2729.   { will write '.' until 2 seconds have passed. }
  2730.  
  2731.  
  2732. -*)
  2733.  
  2734.  
  2735. Function  SwatchExpired(          Swatch1        : TSwatch;
  2736.                                   Expire100s     : LONGINT   ) : BOOLEAN;
  2737.  
  2738. Var
  2739.  
  2740.   TheCurrSwatch : TSwatch;
  2741.   YesterdayDiff : REAL;
  2742.  
  2743. BEGIN
  2744.  
  2745.   TheCurrSwatch := CurrSwatch;
  2746.  
  2747.   {-----------------------------}
  2748.   { did we roll past midnight?? }
  2749.   {-----------------------------}
  2750.  
  2751.   If TheCurrSwatch>=Swatch1 Then
  2752.   BEGIN
  2753.  
  2754.     {------------------------------------------------------}
  2755.     { Nope. Check to see if "expire100s" have passed since }
  2756.     { the swatch1 time.                                    }
  2757.     {------------------------------------------------------}
  2758.  
  2759.     SwatchExpired := ( TheCurrSwatch >= (Swatch1+(Expire100s/100)) )
  2760.  
  2761.   END
  2762.   ELSE
  2763.   BEGIN
  2764.  
  2765.     {------------------------------------------------------}
  2766.     { Yep.  Calculate the # of 100s that passed yesterday, }
  2767.     { and check to see if "expire100s" is greater than     }
  2768.     { the 100s from yesterday + the 100s so far today.     }
  2769.     {------------------------------------------------------}
  2770.  
  2771.     YesterdayDiff := cdt100sinDay - Swatch1;
  2772.  
  2773.     SwatchExpired := ( (YesterdayDiff+TheCurrSwatch) >= (Expire100s/100) );
  2774.  
  2775.   END; { if (not past midnight) / else }
  2776.  
  2777. END; { function swatchexpired }
  2778.  
  2779. {────────────────────────────────────────────────────────────────────────────}
  2780.  
  2781. (*-
  2782.  
  2783. [FUNCTION]
  2784.  
  2785. Function GetTicksSinceMidnt(  Var Days           : BYTE      ) : LONGINT;
  2786.  
  2787. [PARAMETERS]
  2788.  
  2789. Days        VAR Returned ?
  2790.  
  2791. [RETURNS]
  2792.  
  2793. [DESCRIPTION]
  2794.  
  2795. [SEE-ALSO]
  2796.  
  2797. [EXAMPLE]
  2798.  
  2799. -*)
  2800.  
  2801. Function GetTicksSinceMidnt(  Var Days           : BYTE      ) : LONGINT;
  2802.  
  2803. {$IFNDEF OS2}
  2804.  
  2805. Assembler;
  2806. ASM
  2807.  
  2808.   LES  DI, [Days]
  2809.  
  2810.   MOV  AH, $00
  2811.   INT  $1A
  2812.  
  2813.   JC   @@1                   {Carry Flag = Error}
  2814.  
  2815.   MOV  byte PTR ES:SI, AL    {No Error = Store Function Results}
  2816.   MOV  AX, DX
  2817.   MOV  DX, CX
  2818.   JMP  @@2
  2819.  
  2820.  @@1:
  2821.   MOV  byte PTR ES:SI, 0     {Error = Zero Out Function Result}
  2822.   XOR  AX, AX
  2823.   XOR  DX, DX
  2824.  
  2825.  @@2:
  2826.  
  2827. END;  { GetTicksSinceMidnt }
  2828.  
  2829. {$ELSE}
  2830.  
  2831. BEGIN
  2832.  
  2833.   Halt( 69 );  {!^!}
  2834.  
  2835. END;
  2836.  
  2837. {$ENDIF}
  2838.  
  2839. {────────────────────────────────────────────────────────────────────────────}
  2840.  
  2841. (*-
  2842.  
  2843. [FUNCTION]
  2844.  
  2845. Function SetTicksSinceMidnt(      Ticks          : LONGINT   ) : BOOLEAN;
  2846.  
  2847. [PARAMETERS]
  2848.  
  2849. Ticks       ?
  2850.  
  2851. [RETURNS]
  2852.  
  2853. [DESCRIPTION]
  2854.  
  2855. [SEE-ALSO]
  2856.  
  2857. [EXAMPLE]
  2858.  
  2859. -*)
  2860.  
  2861. Function SetTicksSinceMidnt(      Ticks          : LONGINT   ) : BOOLEAN;
  2862.  
  2863. {$IFNDEF OS2}
  2864.  
  2865. Assembler;
  2866. ASM
  2867.  
  2868.   MOV  CX, word PTR [Ticks+2]
  2869.   MOV  DX, word PTR [Ticks  ]
  2870.  
  2871.   MOV  AH, $01
  2872.   INT  $1A
  2873.  
  2874.   MOV  AL, 1                 { Default = No Error }
  2875.   JNC   @NoErr
  2876.  
  2877.   XOR  AL, AL                { Error = Carry Flag Set }
  2878.  
  2879.   @NoErr:
  2880.  
  2881. END;  { SetTicksSinceMidnt }
  2882.  
  2883. {$ELSE}
  2884.  
  2885. BEGIN
  2886.  
  2887.   Halt( 69 );  {!^!}
  2888.  
  2889. END;
  2890.  
  2891. {$ENDIF}
  2892.  
  2893.  
  2894. {────────────────────────────────────────────────────────────────────────────}
  2895.  
  2896. (*-
  2897.  
  2898. [FUNCTION]
  2899.  
  2900. Function GetSysTime(          Var BCDHours       : BYTE;
  2901.                               Var BCDMins        : BYTE;
  2902.                               Var BCDSecs        : BYTE;
  2903.                               Var DSTActive      : BOOLEAN   ) : BOOLEAN;
  2904.  
  2905. [PARAMETERS]
  2906.  
  2907. BCDHours    VAR Returned ?
  2908. BCDMins     VAR Returned ?
  2909. BCDSecs     VAR Returned ?
  2910. DSTActive   VAR Returned ?
  2911.  
  2912. [RETURNS]
  2913.  
  2914. [DESCRIPTION]
  2915.  
  2916. [SEE-ALSO]
  2917.  
  2918. [EXAMPLE]
  2919.  
  2920. -*)
  2921.  
  2922. Function GetSysTime(          Var BCDHours       : BYTE;
  2923.                               Var BCDMins        : BYTE;
  2924.                               Var BCDSecs        : BYTE;
  2925.                               Var DSTActive      : BOOLEAN   ) : BOOLEAN;
  2926.  
  2927. {$IFNDEF OS2}
  2928.  
  2929. Assembler;
  2930. ASM
  2931.  
  2932.   PUSH DS
  2933.  
  2934.   MOV  AH, $02
  2935.   INT  $1A
  2936.  
  2937.   JNC @@1   { no err }
  2938.  
  2939.   {THIS IS TEST CODE}
  2940.  
  2941.     LDS SI, [BCDHours]
  2942.     MOV byte PTR [DS:SI], CH
  2943.     MOV byte PTR [DS:SI+1], CL
  2944.     MOV byte PTR [DS:SI+2], DH
  2945.     MOV byte PTR [DS:SI+3], DL
  2946.  
  2947.   {END OF TEST CODE}
  2948.  
  2949.   LES DI, [BCDHours]
  2950.   LDS SI, [BCDMins ]
  2951.  
  2952.   MOV byte PTR ES:DI, CH     { BCD Hours }
  2953.   MOV byte PTR DS:SI, CL     { BCD Minutes }
  2954.  
  2955.   LES DI, [BCDSecs  ]
  2956.   LDS SI, [DSTActive]
  2957.  
  2958.   MOV byte PTR ES:DI, DH     { BCD Seconds }
  2959.   MOV byte PTR DS:SI, DL     { Day Light Savings }
  2960.  
  2961.   JMP @@2
  2962.  
  2963.  @@1:
  2964.   LES DI, [BCDHours]
  2965.   LDS SI, [BCDMins ]
  2966.  
  2967.   MOV byte PTR ES:DI, 0      { BCD Hours }
  2968.   MOV byte PTR DS:SI, 0      { BCD Minutes }
  2969.  
  2970.   LES DI, [BCDSecs  ]
  2971.   LDS SI, [DSTActive]
  2972.  
  2973.   MOV byte PTR ES:DI, 0      { BCD Seconds }
  2974.   MOV byte PTR DS:SI, 0      { Day Light Savings }
  2975.  
  2976.  @@2:
  2977.  
  2978. END;  { GetSysTime }
  2979.  
  2980. {$ELSE}
  2981.  
  2982. BEGIN
  2983.  
  2984.   Halt( 69 );  {!^!}
  2985.  
  2986. END;
  2987.  
  2988. {$ENDIF}
  2989.  
  2990. {────────────────────────────────────────────────────────────────────────────}
  2991.  
  2992. (*-
  2993.  
  2994. [FUNCTION]
  2995.  
  2996. Function SetSysTime(              BCDHours       : BYTE;
  2997.                                   BCDMins        : BYTE;
  2998.                                   BCDSecs        : BYTE;
  2999.                                   DSTActive      : BOOLEAN   ) : BOOLEAN;
  3000.  
  3001. [PARAMETERS]
  3002.  
  3003. BCDHours    ?
  3004. BCDMins     ?
  3005. BCDSecs     ?
  3006. DSTActive   ?
  3007.  
  3008. [RETURNS]
  3009.  
  3010. [DESCRIPTION]
  3011.  
  3012. [SEE-ALSO]
  3013.  
  3014. [EXAMPLE]
  3015.  
  3016. -*)
  3017.  
  3018. Function SetSysTime(              BCDHours       : BYTE;
  3019.                                   BCDMins        : BYTE;
  3020.                                   BCDSecs        : BYTE;
  3021.                                   DSTActive      : BOOLEAN   ) : BOOLEAN;
  3022.  
  3023. {$IFNDEF OS2}
  3024.  
  3025. Assembler;
  3026. ASM
  3027.  
  3028.   MOV  CH, BCDHours
  3029.   MOV  CL, BCDMins
  3030.   MOV  DH, BCDSecs
  3031.   MOV  DL, DSTActive
  3032.  
  3033.   MOV  AH, $03
  3034.   INT  $1A
  3035.  
  3036.   MOV  AL, 1                 { Default = No Error }
  3037.   JNC  @@1
  3038.  
  3039.   XOR  AL, AL                { Error = CFlag }
  3040.  
  3041.  @@1:
  3042.  
  3043. END;  { SetSysTime }
  3044.  
  3045. {$ELSE}
  3046.  
  3047. BEGIN
  3048.  
  3049.   Halt( 69 );  {!^!}
  3050.  
  3051. END;
  3052.  
  3053. {$ENDIF}
  3054.  
  3055.  
  3056. {────────────────────────────────────────────────────────────────────────────}
  3057.  
  3058. (*-
  3059.  
  3060. [FUNCTION]
  3061.  
  3062. Function GetSysDate(          Var BCDDay         : BYTE;
  3063.                               Var BCDMon         : BYTE;
  3064.                               Var BCDYear        : BYTE;
  3065.                               Var BCDCent        : BYTE      ) : BOOLEAN;
  3066.  
  3067. [PARAMETERS]
  3068.  
  3069. BCDDay      VAR Returned ?
  3070. BCDMon      VAR Returned ?
  3071. BCDYear     VAR Returned ?
  3072. BCDCent     VAR Returned ?
  3073.  
  3074. [RETURNS]
  3075.  
  3076. [DESCRIPTION]
  3077.  
  3078. [SEE-ALSO]
  3079.  
  3080. [EXAMPLE]
  3081.  
  3082. -*)
  3083.  
  3084. Function GetSysDate(          Var BCDDay         : BYTE;
  3085.                               Var BCDMon         : BYTE;
  3086.                               Var BCDYear        : BYTE;
  3087.                               Var BCDCent        : BYTE      ) : BOOLEAN;
  3088. {$IFNDEF OS2}
  3089.  
  3090. Assembler;
  3091. ASM
  3092.  
  3093.   PUSH DS
  3094.  
  3095.   MOV  AH, $04
  3096.   INT  $1A
  3097.  
  3098.   JNC @@1   { no err }
  3099.  
  3100.   LES DI, [BCDDay ]
  3101.   LDS SI, [BCDMon ]
  3102.   MOV byte PTR ES:DI, DL     { BCD Day   }
  3103.   MOV byte PTR DS:SI, DH     { BCD Month }
  3104.  
  3105.   LES DI, [BCDYear]
  3106.   LDS SI, [BCDCent]
  3107.   MOV byte PTR ES:DI, CL     { BCD Year    }
  3108.   MOV byte PTR DS:SI, CH     { Day Century }
  3109.  
  3110.   JMP @@2
  3111.  
  3112.  @@1:
  3113.   LES DI, [BCDDay ]
  3114.   LDS SI, [BCDMon ]
  3115.   MOV byte PTR ES:DI, 0      { BCD Day   }
  3116.   MOV byte PTR DS:SI, 0      { BCD Month }
  3117.  
  3118.   LES DI, [BCDYear]
  3119.   LDS SI, [BCDCent]
  3120.   MOV byte PTR ES:DI, 0      { BCD Year    }
  3121.   MOV byte PTR DS:SI, 0      { Day Century }
  3122.  
  3123.  @@2:
  3124.  
  3125. END;  { GetSysDate }
  3126.  
  3127. {$ELSE}
  3128.  
  3129. BEGIN
  3130.  
  3131.   Halt( 69 );  {!^!}
  3132.  
  3133. END;
  3134.  
  3135. {$ENDIF}
  3136.  
  3137.  
  3138. {────────────────────────────────────────────────────────────────────────────}
  3139.  
  3140. (*-
  3141.  
  3142. [FUNCTION]
  3143.  
  3144. Function SetSysDate(              BCDDay         : BYTE;
  3145.                                   BCDMon         : BYTE;
  3146.                                   BCDYear        : BYTE;
  3147.                                   BCDCent        : BYTE      ) : BOOLEAN;
  3148.  
  3149. [PARAMETERS]
  3150.  
  3151. BCDDay      ?
  3152. BCDMon      ?
  3153. BCDYear     ?
  3154. BCDCent     ?
  3155.  
  3156. [RETURNS]
  3157.  
  3158. [DESCRIPTION]
  3159.  
  3160. [SEE-ALSO]
  3161.  
  3162. [EXAMPLE]
  3163.  
  3164. -*)
  3165.  
  3166. Function SetSysDate(              BCDDay         : BYTE;
  3167.                                   BCDMon         : BYTE;
  3168.                                   BCDYear        : BYTE;
  3169.                                   BCDCent        : BYTE      ) : BOOLEAN;
  3170. {$IFNDEF OS2}
  3171.  
  3172. Assembler;
  3173. ASM
  3174.  
  3175.   MOV  DL, BCDDay
  3176.   MOV  DH, BCDMon
  3177.   MOV  CL, BCDYear
  3178.   MOV  CH, BCDCent
  3179.  
  3180.   MOV  AH, $05
  3181.   INT  $1A
  3182.  
  3183.   MOV  AL, 1                 { Default = No Error }
  3184.   JNC  @@1
  3185.  
  3186.   XOR  AL, AL                { Error = CFlag }
  3187.  
  3188.  @@1:
  3189.  
  3190. END;  { SetSysDate }
  3191.  
  3192. {$ELSE}
  3193.  
  3194. BEGIN
  3195.  
  3196.   Halt( 69 );  {!^!}
  3197.  
  3198. END;
  3199.  
  3200. {$ENDIF}
  3201.  
  3202.  
  3203. {────────────────────────────────────────────────────────────────────────────}
  3204.  
  3205. (*-
  3206.  
  3207. [FUNCTION]
  3208.  
  3209. Function SetSysAlarmOn(           BCDHours       : BYTE;
  3210.                                   BCDMins        : BYTE;
  3211.                                   BCDSecs        : BYTE      ) : BOOLEAN;
  3212. [PARAMETERS]
  3213.  
  3214. BCDHours    Alarm Hours in BCD Format
  3215. BCDMins     Alarm Minutes in BCD Format
  3216. BCDSecs     Alarm Seconds in BCD Format
  3217.  
  3218. [RETURNS]
  3219.  
  3220. Whether the Alarm was set to the provided Time  (TRUE=Alarm Set)
  3221.  
  3222. [DESCRIPTION]
  3223.  
  3224. [SEE-ALSO]
  3225.  
  3226. [EXAMPLE]
  3227.  
  3228. -*)
  3229.  
  3230. Function SetSysAlarmOn(           BCDHours       : BYTE;
  3231.                                   BCDMins        : BYTE;
  3232.                                   BCDSecs        : BYTE      ) : BOOLEAN;
  3233. {$IFNDEF OS2}
  3234.  
  3235. Assembler;
  3236. ASM
  3237.  
  3238.   MOV  CH, BCDHours
  3239.   MOV  CL, BCDMins
  3240.   MOV  DH, BCDSecs
  3241.  
  3242.   MOV  AH, $06
  3243.   INT  $1A
  3244.  
  3245.   MOV  AL, 1                 { Default = No Error }
  3246.   JNC  @@1
  3247.  
  3248.   XOR  AL, AL                { Error = CFlag, if Alarm PreSet or NoClock }
  3249.  
  3250.  @@1:
  3251.  
  3252. END;  { SetSysAlarmOn }
  3253.  
  3254. {$ELSE}
  3255.  
  3256. BEGIN
  3257.  
  3258.   Halt( 69 );  {!^!}
  3259.  
  3260. END;
  3261.  
  3262. {$ENDIF}
  3263.  
  3264. {────────────────────────────────────────────────────────────────────────────}
  3265.  
  3266. (*-
  3267.  
  3268. [FUNCTION]
  3269.  
  3270. Function SetSysAlarmOff                                        : BOOLEAN;
  3271.  
  3272. [PARAMETERS]
  3273.  
  3274. (None)
  3275.  
  3276. [RETURNS]
  3277.  
  3278. Whether the System Alarm is Off (TRUE=Off)
  3279.  
  3280. [DESCRIPTION]
  3281.  
  3282. [SEE-ALSO]
  3283.  
  3284. [EXAMPLE]
  3285.  
  3286. -*)
  3287.  
  3288. Function SetSysAlarmOff                                        : BOOLEAN;
  3289.  
  3290.  
  3291. {$IFNDEF OS2}
  3292.  
  3293. Assembler;
  3294. ASM
  3295.  
  3296.   MOV  AH, $07
  3297.   INT  $1A
  3298.  
  3299.   MOV  AL, 1                 { Default = No Error }
  3300.   JNC  @@1
  3301.  
  3302.   XOR  AL, AL                { Error = CFlag }
  3303.  
  3304.  @@1:
  3305.  
  3306. END;  { SetSysAlarmOff }
  3307.  
  3308. {$ELSE}
  3309.  
  3310. BEGIN
  3311.  
  3312.   Halt( 69 );  {!^!}
  3313.  
  3314. END;
  3315.  
  3316. {$ENDIF}
  3317.  
  3318. Procedure Sleep(                  Sleep100s      : LONGINT   );
  3319.  
  3320. Var
  3321.  
  3322.   Sw : TSwatch;
  3323.  
  3324. BEGIN
  3325.  
  3326.   Sw := CurrSwatch;
  3327.  
  3328.   While Not SwatchExpired( Sw, Sleep100s ) Do;
  3329.  
  3330. END;
  3331.  
  3332.  
  3333. {────────────────────────────────────────────────────────────────────────────}
  3334. {────────────────────────────────────────────────────────────────────────────}
  3335. {────────────────────────────────────────────────────────────────────────────}
  3336.  
  3337. BEGIN
  3338. END.
  3339.  
  3340.  
  3341. TPackedDT information:
  3342. ======================
  3343.  
  3344.   1 LONGINT = 2 WORD
  3345.               (DATE) yyyyyyymmmmddddd =
  3346.  
  3347.                 [(Year - 1980) * 512] + (Month * 32) + Day
  3348.  
  3349.               (TIME) hhhhhmmmmmmsssss =
  3350.  
  3351.                 (Hour SHL 10) + (Min SHL 5) + (Sec DIV 2)
  3352.  
  3353.